From e2e73a436ed40247aba5b8905110c55f0806ce8e Mon Sep 17 00:00:00 2001 From: MARY Alexandre Date: Tue, 11 Oct 2022 13:44:57 +0000 Subject: [PATCH 01/25] equivalent to ectrans in CY48T3_mrg48R1.02:contrib/ --- src/trans/algor/fft992.F90 | 53 +++ src/trans/external/gath_spec.F90 | 19 +- src/trans/external/setup_trans0.F90 | 12 +- src/trans/include/ectrans/setup_trans0.h | 5 +- src/trans/internal/dist_spec_control_mod.F90 | 11 +- src/trans/internal/ftdir_ctl_mod.F90 | 23 +- src/trans/internal/ftdir_ctlad_mod.F90 | 22 +- src/trans/internal/ftdir_mod.F90 | 6 +- src/trans/internal/ftinv_ctl_mod.F90 | 31 +- src/trans/internal/ftinv_ctlad_mod.F90 | 21 +- src/trans/internal/gath_spec_control_mod.F90 | 374 +++++++++++-------- src/trans/internal/gpnorm_trans_ctl_mod.F90 | 2 + src/trans/internal/tpm_gen.F90 | 5 + src/trans/internal/trgtol_mod.F90 | 194 ++++++++-- src/trans/internal/trltog_mod.F90 | 205 ++++++++-- 15 files changed, 712 insertions(+), 271 deletions(-) diff --git a/src/trans/algor/fft992.F90 b/src/trans/algor/fft992.F90 index efc9afa3a..b8f172dfd 100644 --- a/src/trans/algor/fft992.F90 +++ b/src/trans/algor/fft992.F90 @@ -479,6 +479,7 @@ SUBROUTINE RPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 210 IJK=1,ILOT C(JA+J)=A(IA+I)+A(IB+I) C(JB+J)=A(IA+I)-A(IB+I) @@ -506,6 +507,7 @@ SUBROUTINE RPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 230 IJK=1,ILOT C(JA+J)=A(IA+I)+A(IB+I) D(JA+J)=B(IA+I)-B(IB+I) @@ -530,6 +532,7 @@ SUBROUTINE RPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 270 IJK=1,ILOT C(JA+J)=A(IA+I) C(JB+J)=-B(IA+I) @@ -546,6 +549,7 @@ SUBROUTINE RPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & DO 294 L=1,ILA I=IBASE !OCL NOVREC +!NEC$ ivdep DO 292 IJK=1,ILOT T1=2.0*(A(IA+I)-A(IB+I)) A(IA+I)=2.0_JPRB*(A(IA+I)+A(IB+I)) @@ -560,6 +564,7 @@ SUBROUTINE RPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 296 IJK=1,ILOT C(JA+J)=2.0_JPRB*(A(IA+I)+A(IB+I)) C(JB+J)=2.0_JPRB*(A(IA+I)-A(IB+I)) @@ -591,6 +596,7 @@ SUBROUTINE RPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 310 IJK=1,ILOT C(JA+J)=A(IA+I)+A(IB+I) C(JB+J)=(A(IA+I)-0.5_JPRB*A(IB+I))-(SIN60*(B(IB+I))) @@ -622,6 +628,7 @@ SUBROUTINE RPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 330 IJK=1,ILOT C(JA+J)=A(IA+I)+(A(IB+I)+A(IC+I)) D(JA+J)=B(IA+I)+(B(IB+I)-B(IC+I)) @@ -665,6 +672,7 @@ SUBROUTINE RPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 370 IJK=1,ILOT C(JA+J)=A(IA+I)+A(IB+I) C(JB+J)=(0.5_JPRB*A(IA+I)-A(IB+I))-(SIN60*B(IA+I)) @@ -683,6 +691,7 @@ SUBROUTINE RPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & DO 394 L=1,ILA I=IBASE !OCL NOVREC +!NEC$ ivdep DO 392 IJK=1,ILOT T1=(2.0_JPRB*A(IA+I)-A(IB+I))-(SSIN60*B(IB+I)) T2=(2.0_JPRB*A(IA+I)-A(IB+I))+(SSIN60*B(IB+I)) @@ -699,6 +708,7 @@ SUBROUTINE RPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 396 IJK=1,ILOT C(JA+J)=2.0_JPRB*(A(IA+I)+A(IB+I)) C(JB+J)=(2.0_JPRB*A(IA+I)-A(IB+I))-(SSIN60*B(IB+I)) @@ -733,6 +743,7 @@ SUBROUTINE RPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 410 IJK=1,ILOT C(JA+J)=(A(IA+I)+A(IC+I))+A(IB+I) C(JB+J)=(A(IA+I)-A(IC+I))-B(IB+I) @@ -769,6 +780,7 @@ SUBROUTINE RPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 430 IJK=1,ILOT C(JA+J)=(A(IA+I)+A(IC+I))+(A(IB+I)+A(ID+I)) D(JA+J)=(B(IA+I)-B(IC+I))+(B(IB+I)-B(ID+I)) @@ -812,6 +824,7 @@ SUBROUTINE RPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 470 IJK=1,ILOT C(JA+J)=A(IA+I)+A(IB+I) C(JB+J)=SIN45*((A(IA+I)-A(IB+I))-(B(IA+I)+B(IB+I))) @@ -830,6 +843,7 @@ SUBROUTINE RPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & DO 494 L=1,ILA I=IBASE !OCL NOVREC +!NEC$ ivdep DO 492 IJK=1,ILOT T1=2.0_JPRB*((A(IA+I)-A(IC+I))-B(IB+I)) T2=2.0_JPRB*((A(IA+I)+A(IC+I))-A(IB+I)) @@ -848,6 +862,7 @@ SUBROUTINE RPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 496 IJK=1,ILOT C(JA+J)=2.0_JPRB*((A(IA+I)+A(IC+I))+A(IB+I)) C(JB+J)=2.0_JPRB*((A(IA+I)-A(IC+I))-B(IB+I)) @@ -885,6 +900,7 @@ SUBROUTINE RPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 510 IJK=1,ILOT C(JA+J)=A(IA+I)+(A(IB+I)+A(IC+I)) C(JB+J)=((A(IA+I)-0.25_JPRB*(A(IB+I)+A(IC+I)))+ & @@ -930,6 +946,7 @@ SUBROUTINE RPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 530 IJK=1,ILOT ! A10=(A(IA+I)-0.25_JPRB*((A(IB+I)+A(IE+I))+(A(IC+I)+A(ID+I)))) & @@ -978,6 +995,7 @@ SUBROUTINE RPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 570 IJK=1,ILOT C(JA+J)=(A(IA+I)+A(IB+I))+A(IC+I) C(JB+J)=(QRT5*(A(IA+I)-A(IB+I))+ & @@ -1008,6 +1026,7 @@ SUBROUTINE RPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & DO 594 L=1,ILA I=IBASE !OCL NOVREC +!NEC$ ivdep DO 592 IJK=1,ILOT T1=(2.0_JPRB*(A(IA+I)-0.25_JPRB*(A(IB+I)+A(IC+I))) & & +QQRT5*(A(IB+I)-A(IC+I)))-(SSIN72*B(IB+I)+SSIN36*B(IC+I)) @@ -1032,6 +1051,7 @@ SUBROUTINE RPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 596 IJK=1,ILOT C(JA+J)=2.0_JPRB*(A(IA+I)+(A(IB+I)+A(IC+I))) C(JB+J)=(2.0_JPRB*(A(IA+I)-0.25_JPRB*(A(IB+I)+A(IC+I))) & @@ -1076,6 +1096,7 @@ SUBROUTINE RPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 610 IJK=1,ILOT C(JA+J)=(A(IA+I)+A(ID+I))+(A(IB+I)+A(IC+I)) C(JD+J)=(A(IA+I)-A(ID+I))-(A(IB+I)-A(IC+I)) @@ -1126,6 +1147,7 @@ SUBROUTINE RPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 630 IJK=1,ILOT ! A11= (A(IE+I)+A(IB+I))+(A(IC+I)+A(IF+I)) @@ -1181,6 +1203,7 @@ SUBROUTINE RPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 670 IJK=1,ILOT C(JA+J)=A(IB+I)+(A(IA+I)+A(IC+I)) C(JD+J)=B(IB+I)-(B(IA+I)+B(IC+I)) @@ -1206,6 +1229,7 @@ SUBROUTINE RPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & DO 694 L=1,ILA I=IBASE !OCL NOVREC +!NEC$ ivdep DO 692 IJK=1,ILOT T1=(2.0_JPRB*(A(IA+I)-A(ID+I))+(A(IB+I)-A(IC+I))) & & -(SSIN60*(B(IB+I)+B(IC+I))) @@ -1233,6 +1257,7 @@ SUBROUTINE RPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 696 IJK=1,ILOT C(JA+J)=(2.0_JPRB*(A(IA+I)+A(ID+I)))+ & & (2.0_JPRB*(A(IB+I)+A(IC+I))) @@ -1282,6 +1307,7 @@ SUBROUTINE RPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & DO 820 L=1,ILA I=IBASE !OCL NOVREC +!NEC$ ivdep DO 810 IJK=1,ILOT T2=2.0_JPRB*(((A(IA+I)+A(IE+I))-A(IC+I))-(B(IB+I)-B(ID+I))) T6=2.0_JPRB*(((A(IA+I)+A(IE+I))-A(IC+I))+(B(IB+I)-B(ID+I))) @@ -1312,6 +1338,7 @@ SUBROUTINE RPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 830 IJK=1,ILOT C(JA+J)=2.0_JPRB*(((A(IA+I)+A(IE+I))+A(IC+I))+(A(IB+I)+A(ID+I))) C(JE+J)=2.0_JPRB*(((A(IA+I)+A(IE+I))+A(IC+I))-(A(IB+I)+A(ID+I))) @@ -1455,6 +1482,7 @@ SUBROUTINE QPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 210 IJK=1,ILOT C(JA+J)=A(IA+I)+A(IB+I) C(JB+J)=A(IA+I)-A(IB+I) @@ -1481,6 +1509,7 @@ SUBROUTINE QPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 230 IJK=1,ILOT C(JA+J)=A(IA+I)+(C1*A(IB+I)+S1*B(IB+I)) C(JB+J)=A(IA+I)-(C1*A(IB+I)+S1*B(IB+I)) @@ -1505,6 +1534,7 @@ SUBROUTINE QPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 270 IJK=1,ILOT C(JA+J)=A(IA+I) D(JA+J)=-A(IB+I) @@ -1523,6 +1553,7 @@ SUBROUTINE QPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & I=IBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 292 IJK=1,ILOT T1=Z*(A(IA+I)-A(IB+I)) A(IA+I)=Z*(A(IA+I)+A(IB+I)) @@ -1537,6 +1568,7 @@ SUBROUTINE QPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 296 IJK=1,ILOT C(JA+J)=Z*(A(IA+I)+A(IB+I)) C(JB+J)=Z*(A(IA+I)-A(IB+I)) @@ -1568,6 +1600,7 @@ SUBROUTINE QPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 310 IJK=1,ILOT C(JA+J)=A(IA+I)+(A(IB+I)+A(IC+I)) C(JB+J)=A(IA+I)-0.5_JPRB*(A(IB+I)+A(IC+I)) @@ -1599,6 +1632,7 @@ SUBROUTINE QPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 330 IJK=1,ILOT A1=(C1*A(IB+I)+S1*B(IB+I))+(C2*A(IC+I)+S2*B(IC+I)) B1=(C1*B(IB+I)-S1*A(IB+I))+(C2*B(IC+I)-S2*A(IC+I)) @@ -1632,6 +1666,7 @@ SUBROUTINE QPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 370 IJK=1,ILOT C(JA+J)=A(IA+I)+0.5_JPRB*(A(IB+I)-A(IC+I)) D(JA+J)=-SIN60*(A(IB+I)+A(IC+I)) @@ -1652,6 +1687,7 @@ SUBROUTINE QPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & I=IBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 392 IJK=1,ILOT T1=Z*(A(IA+I)-0.5_JPRB*(A(IB+I)+A(IC+I))) T2=ZSIN60*(A(IC+I)-A(IB+I)) @@ -1668,6 +1704,7 @@ SUBROUTINE QPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 396 IJK=1,ILOT C(JA+J)=Z*(A(IA+I)+(A(IB+I)+A(IC+I))) C(JB+J)=Z*(A(IA+I)-0.5_JPRB*(A(IB+I)+A(IC+I))) @@ -1702,6 +1739,7 @@ SUBROUTINE QPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 410 IJK=1,ILOT C(JA+J)=(A(IA+I)+A(IC+I))+(A(IB+I)+A(ID+I)) C(JC+J)=(A(IA+I)+A(IC+I))-(A(IB+I)+A(ID+I)) @@ -1738,6 +1776,7 @@ SUBROUTINE QPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 430 IJK=1,ILOT A0=A(IA+I)+(C2*A(IC+I)+S2*B(IC+I)) A2=A(IA+I)-(C2*A(IC+I)+S2*B(IC+I)) @@ -1777,6 +1816,7 @@ SUBROUTINE QPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 470 IJK=1,ILOT C(JA+J)=A(IA+I)+SIN45*(A(IB+I)-A(ID+I)) C(JB+J)=A(IA+I)-SIN45*(A(IB+I)-A(ID+I)) @@ -1797,6 +1837,7 @@ SUBROUTINE QPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & I=IBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 492 IJK=1,ILOT T1=Z*(A(IA+I)-A(IC+I)) T3=Z*(A(ID+I)-A(IB+I)) @@ -1815,6 +1856,7 @@ SUBROUTINE QPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 496 IJK=1,ILOT C(JA+J)=Z*((A(IA+I)+A(IC+I))+(A(IB+I)+A(ID+I))) C(JC+J)=Z*((A(IA+I)+A(IC+I))-(A(IB+I)+A(ID+I))) @@ -1852,6 +1894,7 @@ SUBROUTINE QPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 510 IJK=1,ILOT A1=A(IB+I)+A(IE+I) A3=A(IB+I)-A(IE+I) @@ -1899,6 +1942,7 @@ SUBROUTINE QPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 530 IJK=1,ILOT A1=(C1*A(IB+I)+S1*B(IB+I))+(C4*A(IE+I)+S4*B(IE+I)) A3=(C1*A(IB+I)+S1*B(IB+I))-(C4*A(IE+I)+S4*B(IE+I)) @@ -1952,6 +1996,7 @@ SUBROUTINE QPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 570 IJK=1,ILOT A1=A(IB+I)+A(IE+I) A3=A(IB+I)-A(IE+I) @@ -1982,6 +2027,7 @@ SUBROUTINE QPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & I=IBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 592 IJK=1,ILOT A1=A(IB+I)+A(IE+I) A3=A(IB+I)-A(IE+I) @@ -2004,6 +2050,7 @@ SUBROUTINE QPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 596 IJK=1,ILOT A1=A(IB+I)+A(IE+I) A3=A(IB+I)-A(IE+I) @@ -2050,6 +2097,7 @@ SUBROUTINE QPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 610 IJK=1,ILOT A11=(A(IC+I)+A(IF+I))+(A(IB+I)+A(IE+I)) C(JA+J)=(A(IA+I)+A(ID+I))+A11 @@ -2098,6 +2146,7 @@ SUBROUTINE QPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 630 IJK=1,ILOT A1=C1*A(IB+I)+S1*B(IB+I) B1=C1*B(IB+I)-S1*A(IB+I) @@ -2156,6 +2205,7 @@ SUBROUTINE QPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 670 IJK=1,ILOT C(JA+J)=(A(IA+I)+0.5_JPRB*(A(IC+I)-A(IE+I)))+ & & SIN60*(A(IB+I)-A(IF+I)) @@ -2183,6 +2233,7 @@ SUBROUTINE QPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & I=IBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 692 IJK=1,ILOT A11=(A(IC+I)-A(IF+I))+(A(IE+I)-A(IB+I)) T1=Z*((A(IA+I)-A(ID+I))-0.5_JPRB*A11) @@ -2207,6 +2258,7 @@ SUBROUTINE QPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & J=JBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 696 IJK=1,ILOT A11=(A(IC+I)+A(IF+I))+(A(IB+I)+A(IE+I)) C(JA+J)=Z*((A(IA+I)+A(ID+I))+A11) @@ -2254,6 +2306,7 @@ SUBROUTINE QPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & I=IBASE !OCL NOVREC !DEC$ IVDEP +!NEC$ ivdep DO 810 IJK=1,ILOT T3=Z*((A(IA+I)+A(IE+I))-(A(IC+I)+A(IG+I))) T4=Z*((A(ID+I)+A(IH+I))-(A(IB+I)+A(IF+I))) diff --git a/src/trans/external/gath_spec.F90 b/src/trans/external/gath_spec.F90 index e1abc9699..79c1e7247 100644 --- a/src/trans/external/gath_spec.F90 +++ b/src/trans/external/gath_spec.F90 @@ -83,9 +83,13 @@ SUBROUTINE GATH_SPEC(PSPECG,KFGATHG,KTO,KVSET,KRESOL,PSPEC,LDIM1_IS_FLD,KSMAX,LD INTEGER(KIND=JPIM) :: IVSET(KFGATHG) INTEGER(KIND=JPIM) :: IFRECV,IFSEND,J INTEGER(KIND=JPIM) :: IFLD,ICOEFF -INTEGER(KIND=JPIM) :: ISMAX, ISPEC2, ISPEC2_G +INTEGER(KIND=JPIM) :: ISMAX, ISPEC2, ISPEC2_G, ISPEC2MX INTEGER(KIND=JPIM) :: IPOSSP(NPRTRW+1) +INTEGER(KIND=JPIM) :: IUMPP(NPRTRW) +INTEGER(KIND=JPIM) :: IPTRMS(NPRTRW) INTEGER(KIND=JPIM),ALLOCATABLE :: IDIM0G(:) +INTEGER(KIND=JPIM),ALLOCATABLE :: IALLMS(:) +INTEGER(KIND=JPIM),ALLOCATABLE :: IKN(:) LOGICAL :: LLDIM1_IS_FLD REAL(KIND=JPHOOK) :: ZHOOK_HANDLE @@ -112,8 +116,11 @@ SUBROUTINE GATH_SPEC(PSPECG,KFGATHG,KTO,KVSET,KRESOL,PSPEC,LDIM1_IS_FLD,KSMAX,LD ISMAX = R%NSMAX IF(PRESENT(KSMAX)) ISMAX = KSMAX ALLOCATE(IDIM0G(0:ISMAX)) +ALLOCATE(IALLMS(ISMAX+1)) +ALLOCATE(IKN(0:ISMAX)) IF(ISMAX /= R%NSMAX) THEN CALL SUWAVEDI(ISMAX,ISMAX,NPRTRW,MYSETW,KPOSSP=IPOSSP,KSPEC2=ISPEC2,& + & KUMPP=IUMPP,KALLMS=IALLMS,KPTRMS=IPTRMS,KSPEC2MX=ISPEC2MX, & & KDIM0G=IDIM0G) ISPEC2_G = (ISMAX+1)*(ISMAX+2) ELSE @@ -121,7 +128,14 @@ SUBROUTINE GATH_SPEC(PSPECG,KFGATHG,KTO,KVSET,KRESOL,PSPEC,LDIM1_IS_FLD,KSMAX,LD ISPEC2_G = R%NSPEC2_G IPOSSP(:) = D%NPOSSP(:) IDIM0G(:) = D%NDIM0G(:) + ISPEC2MX = D%NSPEC2MX + IUMPP(:) = D%NUMPP(:) + IALLMS(:) = D%NALLMS(:) + IPTRMS(:) = D%NPTRMS(:) ENDIF +DO J=0,ISMAX + IKN(J)=2*(ISMAX+1-J) +ENDDO IFSEND = 0 IFRECV = 0 @@ -182,7 +196,7 @@ SUBROUTINE GATH_SPEC(PSPECG,KFGATHG,KTO,KVSET,KRESOL,PSPEC,LDIM1_IS_FLD,KSMAX,LD ENDIF CALL GATH_SPEC_CONTROL(PSPECG,KFGATHG,KTO,IVSET,PSPEC,LLDIM1_IS_FLD,& - & ISMAX,ISPEC2,ISPEC2_G,IPOSSP,IDIM0G,LDZA0IP) + & ISMAX,ISPEC2,ISPEC2MX,ISPEC2_G,IPOSSP,IDIM0G,IUMPP,IALLMS,IPTRMS,IKN,LDZA0IP) DEALLOCATE(IDIM0G) IF (LHOOK) CALL DR_HOOK('GATH_SPEC',1,ZHOOK_HANDLE) @@ -191,4 +205,3 @@ SUBROUTINE GATH_SPEC(PSPECG,KFGATHG,KTO,KVSET,KRESOL,PSPEC,LDIM1_IS_FLD,KSMAX,LD ! ------------------------------------------------------------------ END SUBROUTINE GATH_SPEC - diff --git a/src/trans/external/setup_trans0.F90 b/src/trans/external/setup_trans0.F90 index 5dcd8cff8..740e3606c 100644 --- a/src/trans/external/setup_trans0.F90 +++ b/src/trans/external/setup_trans0.F90 @@ -12,7 +12,7 @@ SUBROUTINE SETUP_TRANS0(KOUT,KERR,KPRINTLEV,KMAX_RESOL,KPROMATR,& & KPRGPNS,KPRGPEW,KPRTRW,KCOMBFLEN,& & LDMPOFF,LDSYNC_TRANS,KTRANS_SYNC_LEVEL,& & LDEQ_REGIONS,K_REGIONS_NS,K_REGIONS_EW,K_REGIONS,& -& PRAD,LDALLOPERM) +& PRAD,LDALLOPERM,KOPT_MEMORY_TR) !**** *SETUP_TRANS0* - General setup routine for transform package @@ -44,6 +44,8 @@ SUBROUTINE SETUP_TRANS0(KOUT,KERR,KPRINTLEV,KMAX_RESOL,KPROMATR,& ! K_REGIONS_EW - Maximum number of EW partitions ! PRAD - Radius of the planet ! LDALLOPERM - Allocate certain arrays permanently +! KOPT_MEMORY_TR - memory strategy (stack vs heap) in gripoint transpositions + ! The total number of (MPI)-processors has to be equal to KPRGPNS*KPRGPEW ! Method. @@ -62,6 +64,7 @@ SUBROUTINE SETUP_TRANS0(KOUT,KERR,KPRINTLEV,KMAX_RESOL,KPROMATR,& ! R. El Khatib 03-01-24 LDMPOFF ! G. Mozdzynski 2006-09-13 LDEQ_REGIONS ! N. Wedi 2009-11-30 add radius +! R. El Khatib 09-Sep-2020 NSTACK_MEMORY_TR ! ------------------------------------------------------------------ @@ -70,7 +73,7 @@ SUBROUTINE SETUP_TRANS0(KOUT,KERR,KPRINTLEV,KMAX_RESOL,KPROMATR,& !ifndef INTERFACE USE TPM_GEN ,ONLY : NERR, NOUT, LMPOFF, LSYNC_TRANS, NTRANS_SYNC_LEVEL, MSETUP0, & - & NMAX_RESOL, NPRINTLEV, NPROMATR, LALLOPERM + & NMAX_RESOL, NPRINTLEV, NPROMATR, LALLOPERM, NSTACK_MEMORY_TR USE TPM_DISTR ,ONLY : LEQ_REGIONS, NCOMBFLEN, NPRGPEW,NPRGPNS, NPRTRW USE TPM_CONSTANTS ,ONLY : RA @@ -90,6 +93,7 @@ SUBROUTINE SETUP_TRANS0(KOUT,KERR,KPRINTLEV,KMAX_RESOL,KPROMATR,& LOGICAL ,OPTIONAL,INTENT(IN) :: LDEQ_REGIONS LOGICAL ,OPTIONAL,INTENT(IN) :: LDALLOPERM REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PRAD +INTEGER(KIND=JPIM) ,OPTIONAL,INTENT(IN) :: KOPT_MEMORY_TR INTEGER(KIND=JPIM) ,OPTIONAL,INTENT(OUT) :: K_REGIONS(:) INTEGER(KIND=JPIM) ,OPTIONAL,INTENT(OUT) :: K_REGIONS_NS INTEGER(KIND=JPIM) ,OPTIONAL,INTENT(OUT) :: K_REGIONS_EW @@ -123,6 +127,7 @@ SUBROUTINE SETUP_TRANS0(KOUT,KERR,KPRINTLEV,KMAX_RESOL,KPROMATR,& LEQ_REGIONS=.FALSE. RA=6371229._JPRB LALLOPERM=.FALSE. +NSTACK_MEMORY_TR=0 ! Optional arguments @@ -173,6 +178,9 @@ SUBROUTINE SETUP_TRANS0(KOUT,KERR,KPRINTLEV,KMAX_RESOL,KPROMATR,& IF(PRESENT(LDEQ_REGIONS)) THEN LEQ_REGIONS = LDEQ_REGIONS ENDIF +IF(PRESENT(KOPT_MEMORY_TR))THEN + NSTACK_MEMORY_TR = KOPT_MEMORY_TR +ENDIF ! Initial setup CALL SUMP_TRANS0 diff --git a/src/trans/include/ectrans/setup_trans0.h b/src/trans/include/ectrans/setup_trans0.h index d05820ee6..b716f60b2 100644 --- a/src/trans/include/ectrans/setup_trans0.h +++ b/src/trans/include/ectrans/setup_trans0.h @@ -13,7 +13,7 @@ SUBROUTINE SETUP_TRANS0(KOUT,KERR,KPRINTLEV,KMAX_RESOL,KPROMATR,& & KPRGPNS,KPRGPEW,KPRTRW,KCOMBFLEN,& & LDMPOFF,LDSYNC_TRANS,KTRANS_SYNC_LEVEL,& & LDEQ_REGIONS,K_REGIONS_NS,K_REGIONS_EW,K_REGIONS,& -& PRAD,LDALLOPERM) +& PRAD,LDALLOPERM,KOPT_MEMORY_TR) !**** *SETUP_TRANS0* - General setup routine for transform package @@ -45,6 +45,7 @@ SUBROUTINE SETUP_TRANS0(KOUT,KERR,KPRINTLEV,KMAX_RESOL,KPROMATR,& ! K_REGIONS_EW - Maximum number of EW partitions ! PRAD - Radius of the planet ! LDALLOPERM - Allocate certain arrays permanently +! KOPT_MEMORY_TR - memory strategy (stack vs heap) in gripoint transpositions ! The total number of (MPI)-processors has to be equal to KPRGPNS*KPRGPEW @@ -64,6 +65,7 @@ SUBROUTINE SETUP_TRANS0(KOUT,KERR,KPRINTLEV,KMAX_RESOL,KPROMATR,& ! R. El Khatib 03-01-24 LDMPOFF ! G. Mozdzynski 2006-09-13 LDEQ_REGIONS ! N. Wedi 2009-11-30 add radius +! R. El Khatib 09-Sep-2020 NSTACK_MEMORY_TR ! ------------------------------------------------------------------ @@ -79,6 +81,7 @@ INTEGER(KIND=JPIM) ,OPTIONAL,INTENT(IN) :: KTRANS_SYNC_LEVEL LOGICAL ,OPTIONAL,INTENT(IN) :: LDEQ_REGIONS LOGICAL ,OPTIONAL,INTENT(IN) :: LDALLOPERM REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PRAD +INTEGER(KIND=JPIM) ,OPTIONAL,INTENT(IN) :: KOPT_MEMORY_TR INTEGER(KIND=JPIM) ,OPTIONAL,INTENT(OUT) :: K_REGIONS(:) INTEGER(KIND=JPIM) ,OPTIONAL,INTENT(OUT) :: K_REGIONS_NS INTEGER(KIND=JPIM) ,OPTIONAL,INTENT(OUT) :: K_REGIONS_EW diff --git a/src/trans/internal/dist_spec_control_mod.F90 b/src/trans/internal/dist_spec_control_mod.F90 index f2e090d7b..05bb1cf76 100644 --- a/src/trans/internal/dist_spec_control_mod.F90 +++ b/src/trans/internal/dist_spec_control_mod.F90 @@ -54,7 +54,9 @@ SUBROUTINE DIST_SPEC_CONTROL(PSPECG,KFDISTG,KFROM,KVSET,PSPEC,LDIM1_IS_FLD,& ! -------------- ! Original : 2000-04-01 ! P.Marguinaud : 2014-10-10 -! R. El Khatib 25-Jul-2019 Optimization by vectorization, proper non-blocking comms and overlapp send/recv with pack/unpack +! R. El Khatib 25-Jul-2019 Optimization by vectorization, proper non-blocking comms +! and overlapp send/recv with pack/unpack +! R. El Khatib 02-Jun-2022 Optimization/Cleaning ! ------------------------------------------------------------------ USE PARKIND1 ,ONLY : JPIM ,JPRB @@ -65,11 +67,11 @@ SUBROUTINE DIST_SPEC_CONTROL(PSPECG,KFDISTG,KFROM,KVSET,PSPEC,LDIM1_IS_FLD,& IMPLICIT NONE -REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPECG(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN), CONTIGUOUS :: PSPECG(:,:) INTEGER(KIND=JPIM) , INTENT(IN) :: KFDISTG INTEGER(KIND=JPIM) , INTENT(IN) :: KFROM(:) INTEGER(KIND=JPIM) , INTENT(IN) :: KVSET(:) -REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPEC(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT), CONTIGUOUS :: PSPEC(:,:) LOGICAL , INTENT(IN) :: LDIM1_IS_FLD INTEGER(KIND=JPIM) , INTENT(IN) :: KSMAX INTEGER(KIND=JPIM) , INTENT(IN) :: KSPEC2 @@ -87,7 +89,7 @@ SUBROUTINE DIST_SPEC_CONTROL(PSPECG,KFDISTG,KFROM,KVSET,PSPEC,LDIM1_IS_FLD,& REAL(KIND=JPRB), ALLOCATABLE :: ZBUF(:,:,:) INTEGER(KIND=JPIM) :: IASM0G(0:KSMAX) INTEGER(KIND=JPIM) :: JM,JN,IFLDR,IFLD,JFLD,ITAG,JNM,ILEN(NPRTRW),JA,ISND(NPRTRV,NPRTRW), JB, IFLDOFF -INTEGER(KIND=JPIM) :: IRCV,ISTP(NPRTRW),ISENDREQ(NPROC), IREQRCV(NPROC), IPROC(NPROC), JMLOC, IFLDBUF, IFLDSPG, IPOSSP +INTEGER(KIND=JPIM) :: IRCV,ISENDREQ(NPROC), IREQRCV(NPROC), IPROC(NPROC), JMLOC, IFLDBUF, IFLDSPG, IPOSSP INTEGER(KIND=JPIM) :: ISMAX, ISPEC2, IPOS0,ISENT, INR, IOFFPROC(NPROC+1), IFLDLOC(KFDISTG), IOFF, ILOCFLD(KFDISTG) INTEGER(KIND=JPIM), POINTER :: ISORT (:) @@ -107,7 +109,6 @@ SUBROUTINE DIST_SPEC_CONTROL(PSPECG,KFDISTG,KFROM,KVSET,PSPEC,LDIM1_IS_FLD,& DO JA=1,NPRTRW ILEN(JA) = KPOSSP(JA+1)-KPOSSP(JA) - ISTP(JA) = KPOSSP(JA+1)-1 ENDDO DO JA=1,NPRTRW DO JB=1,NPRTRV diff --git a/src/trans/internal/ftdir_ctl_mod.F90 b/src/trans/internal/ftdir_ctl_mod.F90 index 45a82b50f..6b1a35210 100644 --- a/src/trans/internal/ftdir_ctl_mod.F90 +++ b/src/trans/internal/ftdir_ctl_mod.F90 @@ -52,13 +52,13 @@ SUBROUTINE FTDIR_CTL(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS, & ! Modifications. ! -------------- ! Original : 00-03-03 - +! R. El Khatib 09-Sep-2020 NSTACK_MEMORY_TR +! R. El Khatib 01-Jun-2022 contiguous pointer ! ------------------------------------------------------------------ USE PARKIND1 ,ONLY : JPIM ,JPRB -!USE TPM_DIM -!USE TPM_GEOMETRY +USE TPM_GEN ,ONLY : NSTACK_MEMORY_TR USE TPM_TRANS ,ONLY : FOUBUF_IN USE TPM_DISTR ,ONLY : D, MYPROC, NPROC @@ -85,7 +85,9 @@ SUBROUTINE FTDIR_CTL(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS, & REAL(KIND=JPRB),OPTIONAL , INTENT(IN) :: PGP2(:,:,:) ! Local variables -REAL(KIND=JPRB) :: ZGTF(KF_FS,D%NLENGTF) +REAL(KIND=JPRB),TARGET :: ZGTF_STACK(KF_FS*MIN(1,MAX(0,NSTACK_MEMORY_TR)),D%NLENGTF) +REAL(KIND=JPRB),TARGET, ALLOCATABLE :: ZGTF_HEAP(:,:) +REAL(KIND=JPRB),POINTER, CONTIGUOUS :: ZGTF(:,:) INTEGER(KIND=JPIM) :: IST,JGL,IGL,IBLEN INTEGER(KIND=JPIM) :: IVSETUV(KF_UV_G) @@ -141,6 +143,19 @@ SUBROUTINE FTDIR_CTL(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS, & IST = IST+KF_SCALARS_G ENDIF +IF (NSTACK_MEMORY_TR == 1) THEN + ZGTF => ZGTF_STACK(:,:) +ELSE + ALLOCATE(ZGTF_HEAP(KF_FS,D%NLENGTF)) +! Now, force the OS to allocate this shared array right now, not when it starts +! to be used which is an OPEN-MP loop, that would cause a threads +! synchronization lock : + IF (KF_FS > 0 .AND. D%NLENGTF > 0) THEN + ZGTF_HEAP(1,1)=HUGE(1._JPRB) + ENDIF + ZGTF => ZGTF_HEAP(:,:) +ENDIF + ! Transposition CALL GSTATS(158,0) diff --git a/src/trans/internal/ftdir_ctlad_mod.F90 b/src/trans/internal/ftdir_ctlad_mod.F90 index 9b08b5e64..8b234a264 100644 --- a/src/trans/internal/ftdir_ctlad_mod.F90 +++ b/src/trans/internal/ftdir_ctlad_mod.F90 @@ -52,14 +52,13 @@ SUBROUTINE FTDIR_CTLAD(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS, & ! Modifications. ! -------------- ! Original : 00-03-03 +! R. El Khatib 09-Sep-2020 NSTACK_MEMORY_TR ! ------------------------------------------------------------------ USE PARKIND1 ,ONLY : JPIM ,JPRB -!USE TPM_GEN -!USE TPM_DIM -!USE TPM_GEOMETRY +USE TPM_GEN ,ONLY : NSTACK_MEMORY_TR USE TPM_DISTR ,ONLY : D, MYPROC, NPROC USE TRLTOG_MOD ,ONLY : TRLTOG @@ -85,8 +84,9 @@ SUBROUTINE FTDIR_CTLAD(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS, & REAL(KIND=JPRB),OPTIONAL , INTENT(OUT) :: PGP2(:,:,:) ! Local variables -REAL(KIND=JPRB) :: ZGTF(KF_FS,D%NLENGTF) - +REAL(KIND=JPRB),TARGET :: ZGTF_STACK(KF_FS*MIN(1,MAX(0,NSTACK_MEMORY_TR)),D%NLENGTF) +REAL(KIND=JPRB),TARGET, ALLOCATABLE :: ZGTF_HEAP(:,:) +REAL(KIND=JPRB),POINTER :: ZGTF(:,:) INTEGER(KIND=JPIM) :: IST INTEGER(KIND=JPIM) :: IVSETUV(KF_UV_G) @@ -102,6 +102,18 @@ SUBROUTINE FTDIR_CTLAD(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS, & CALL GSTATS(133,0) +IF (NSTACK_MEMORY_TR == 1) THEN + ZGTF => ZGTF_STACK(:,:) +ELSE + ALLOCATE(ZGTF_HEAP(KF_FS,D%NLENGTF)) +! Now, force the OS to allocate this shared array right now, not when it starts +! to be used which is an OPEN-MP loop, that would cause a threads synchronization lock : + IF (KF_FS > 0 .AND. D%NLENGTF > 0) THEN + ZGTF_HEAP(1,1)=HUGE(1._JPRB) + ENDIF + ZGTF => ZGTF_HEAP(:,:) +ENDIF + IF(MYPROC > NPROC/2)THEN IBEG=1 IEND=D%NDGL_FS diff --git a/src/trans/internal/ftdir_mod.F90 b/src/trans/internal/ftdir_mod.F90 index 9bf522a99..f4be09e3f 100644 --- a/src/trans/internal/ftdir_mod.F90 +++ b/src/trans/internal/ftdir_mod.F90 @@ -61,7 +61,7 @@ SUBROUTINE FTDIR(PREEL,KFIELDS,KGL) IMPLICIT NONE INTEGER(KIND=JPIM),INTENT(IN) :: KFIELDS,KGL -REAL(KIND=JPRB), INTENT(INOUT) :: PREEL(:,:) +REAL(KIND=JPRB), POINTER, CONTIGUOUS, INTENT(INOUT) :: PREEL(:,:) INTEGER(KIND=JPIM) :: IGLG,IST,ILEN,IJUMP,JJ,JF,IST1 INTEGER(KIND=JPIM) :: IOFF,IRLEN,ICLEN, ITYPE @@ -113,9 +113,7 @@ SUBROUTINE FTDIR(PREEL,KFIELDS,KGL) IST1=1 IF (G%NLOEN(IGLG)==1) IST1=0 DO JJ=IST1,ILEN - DO JF=1,KFIELDS - PREEL(JF,IST+D%NSTAGTF(KGL)+JJ-1) = 0.0_JPRB - ENDDO + PREEL(1:KFIELDS,IST+D%NSTAGTF(KGL)+JJ-1) = 0.0_JPRB ENDDO ! ------------------------------------------------------------------ diff --git a/src/trans/internal/ftinv_ctl_mod.F90 b/src/trans/internal/ftinv_ctl_mod.F90 index 601dd282c..3b00632e2 100644 --- a/src/trans/internal/ftinv_ctl_mod.F90 +++ b/src/trans/internal/ftinv_ctl_mod.F90 @@ -57,14 +57,13 @@ SUBROUTINE FTINV_CTL(KF_UV_G,KF_SCALARS_G,& ! Modifications. ! -------------- ! Original : 00-03-03 +! R. El Khatib 09-Sep-2020 NSTACK_MEMORY_TR ! ------------------------------------------------------------------ USE PARKIND1 ,ONLY : JPIM ,JPRB -USE TPM_GEN ,ONLY : NERR -!USE TPM_DIM -!USE TPM_GEOMETRY +USE TPM_GEN ,ONLY : NERR ,NSTACK_MEMORY_TR USE TPM_TRANS ,ONLY : FOUBUF, LDIVGP, LSCDERS, LUVDER, LVORGP,LATLON USE TPM_DISTR ,ONLY : D, MYPROC, NPROC USE TPM_FLT ,ONLY : S @@ -114,16 +113,10 @@ SUBROUTINE FTINV_CTL(KF_UV_G,KF_SCALARS_G,& #else REAL(KIND=JPRB),TARGET,ALLOCATABLE :: ZDUM(:,:) ! When using this (HEAP) alloc Cray CCE 8.6.2 fails in OMP 1639 #endif -!REAL(KIND=JPRB),TARGET :: ZGTF(KF_FS,D%NLENGTF) ! A stack hog ? -REAL(KIND=JPRB),TARGET,ALLOCATABLE :: ZGTF(:,:) ! (KF_FS,D%NLENGTF) -ALLOCATE(ZGTF(KF_FS,D%NLENGTF)) -! Certain compilers allocate arrays at the moment they start to be used, not at the moment the user -! allocates them. This is a problem if that moment is an open-mp loop because it would trigger -! an omp barrier to let the array be allocated by the master thread if the array is shared (which -! is the case here for zgtf). -! Therefore the next line ensures zgtf is really allocated here, not inside the omp loop. REK -IF (KF_FS > 0 .AND. D%NLENGTF > 0) ZGTF(1,1)=0._JPRB +REAL(KIND=JPRB),TARGET :: ZGTF_STACK(KF_FS*MIN(1,MAX(0,NSTACK_MEMORY_TR)),D%NLENGTF) +REAL(KIND=JPRB),TARGET, ALLOCATABLE :: ZGTF_HEAP(:,:) +REAL(KIND=JPRB),POINTER :: ZGTF(:,:) #if 1 ALLOCATE(ZDUM(1,D%NLENGTF)) @@ -141,6 +134,18 @@ SUBROUTINE FTINV_CTL(KF_UV_G,KF_SCALARS_G,& CALL GSTATS(107,0) +IF (NSTACK_MEMORY_TR == 1) THEN + ZGTF => ZGTF_STACK(:,:) +ELSE + ALLOCATE(ZGTF_HEAP(KF_FS,D%NLENGTF)) +! Now, force the OS to allocate this shared array right now, not when it starts +! to be used which is an OPEN-MP loop, that would cause a threads synchronization lock : + IF (KF_FS > 0 .AND. D%NLENGTF > 0) THEN + ZGTF_HEAP(1,1)=HUGE(1._JPRB) + ENDIF + ZGTF => ZGTF_HEAP(:,:) +ENDIF + IF (KF_UV > 0 .OR. KF_SCDERS > 0 .OR. (LATLON.AND.S%LDLL) ) THEN IST = 1 IF (LVORGP) THEN @@ -291,7 +296,7 @@ SUBROUTINE FTINV_CTL(KF_UV_G,KF_SCALARS_G,& ! ------------------------------------------------------------------ -DEALLOCATE(ZGTF) +!DEALLOCATE(ZGTF) END SUBROUTINE FTINV_CTL END MODULE FTINV_CTL_MOD diff --git a/src/trans/internal/ftinv_ctlad_mod.F90 b/src/trans/internal/ftinv_ctlad_mod.F90 index ad5877903..cceda716b 100644 --- a/src/trans/internal/ftinv_ctlad_mod.F90 +++ b/src/trans/internal/ftinv_ctlad_mod.F90 @@ -58,14 +58,13 @@ SUBROUTINE FTINV_CTLAD(KF_UV_G,KF_SCALARS_G,& ! Modifications. ! -------------- ! Original : 00-03-03 +! R. El Khatib 09-Sep-2020 NSTACK_MEMORY_TR ! ------------------------------------------------------------------ USE PARKIND1 ,ONLY : JPIM ,JPRB -USE TPM_GEN ,ONLY : NERR -!USE TPM_DIM -!USE TPM_GEOMETRY +USE TPM_GEN ,ONLY : NERR ,NSTACK_MEMORY_TR USE TPM_TRANS ,ONLY : FOUBUF, LDIVGP, LSCDERS, LUVDER, LVORGP USE TPM_DISTR ,ONLY : D, MYPROC, NPROC @@ -100,7 +99,9 @@ SUBROUTINE FTINV_CTLAD(KF_UV_G,KF_SCALARS_G,& ! ------------------------------------------------------------------ -REAL(KIND=JPRB),TARGET :: ZGTF(KF_FS,D%NLENGTF) +REAL(KIND=JPRB),TARGET :: ZGTF_STACK(KF_FS*MIN(1,MAX(0,NSTACK_MEMORY_TR)),D%NLENGTF) +REAL(KIND=JPRB),TARGET, ALLOCATABLE :: ZGTF_HEAP(:,:) +REAL(KIND=JPRB),POINTER :: ZGTF(:,:) REAL(KIND=JPRB),TARGET :: ZDUM(1,D%NLENGTF) REAL(KIND=JPRB),POINTER :: ZUV(:,:) REAL(KIND=JPRB),POINTER :: ZSCALAR(:,:) @@ -195,6 +196,18 @@ SUBROUTINE FTINV_CTLAD(KF_UV_G,KF_SCALARS_G,& ENDIF ENDIF +IF (NSTACK_MEMORY_TR == 1) THEN + ZGTF => ZGTF_STACK(:,:) +ELSE + ALLOCATE(ZGTF_HEAP(KF_FS,D%NLENGTF)) +! Now, force the OS to allocate this shared array right now, not when it starts +! to be used which is an OPEN-MP loop, that would cause a threads synchronization lock : + IF (KF_FS > 0 .AND. D%NLENGTF > 0) THEN + ZGTF_HEAP(1,1)=HUGE(1._JPRB) + ENDIF + ZGTF => ZGTF_HEAP(:,:) +ENDIF + CALL GSTATS(182,0) CALL TRGTOL(ZGTF,KF_FS,KF_GP,KF_SCALARS_G,IVSET,KPTRGP,& &PGP,PGPUV,PGP3A,PGP3B,PGP2) diff --git a/src/trans/internal/gath_spec_control_mod.F90 b/src/trans/internal/gath_spec_control_mod.F90 index 7333653f7..c481889bc 100644 --- a/src/trans/internal/gath_spec_control_mod.F90 +++ b/src/trans/internal/gath_spec_control_mod.F90 @@ -11,7 +11,7 @@ MODULE GATH_SPEC_CONTROL_MOD CONTAINS SUBROUTINE GATH_SPEC_CONTROL(PSPECG,KFGATHG,KTO,KVSET,PSPEC,LDIM1_IS_FLD,& - & KSMAX,KSPEC2,KSPEC2_G,KPOSSP,KDIM0G,LDZA0IP) + & KSMAX,KSPEC2,KSPEC2MX,KSPEC2G,KPOSSP,KDIM0G,KUMPP,KALLMS,KPTRMS,KN,LDZA0IP) !**** *GATH_SPEC_CONTROL* - Gather global spectral array from processors @@ -26,28 +26,45 @@ SUBROUTINE GATH_SPEC_CONTROL(PSPECG,KFGATHG,KTO,KVSET,PSPEC,LDIM1_IS_FLD,& ! Explicit arguments : ! -------------------- ! PSPECG(:,:) - Global spectral array -! KFGATHG - Global number of fields to be distributed +! KFGATHG - Global number of fields to be gathered ! KTO(:) - Processor responsible for distributing each field ! KVSET(:) - "B-Set" for each field ! PSPEC(:,:) - Local spectral array -! LDZA0IP - Set first coefficients (imaginary part) to zero +! LDIM1_IS_FLD - .TRUE. if first dimension contains the fields +! KSMAX - Spectral truncation limit +! KSPEC2 - Local number of spectral coefficients +! KSPEC2MX - Maximum local number of spectral coefficients +! KSPEC2G - Global number of spectral coefficients +! KPOSSP - Position of local waves for each task +! KDIM0G - Defines partitioning of global spectral fields among PEs +! KUMPP - Number of spectral waves on this a-set +! KALLMS - Wave numbers for all a-set concatenated together to give all wave numbers in a-set order +! KPTRMS - Pointer to the first wave number of a given a-set in kallms array. +! KN - Number of spectral coefficients for each m wave +! LDZA0IP - Set first coefficients (imaginary part) to zero (global model only) +! Externals. SET2PE - compute "A and B" set from PE +! ---------- MPL.. - message passing routines + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 2000-04-01 +! R. El Khatib 02-Dec-2020 re-write for optimizations and merge with LAM counterpart ! ------------------------------------------------------------------ USE PARKIND1 ,ONLY : JPIM ,JPRB -USE MPL_MODULE ,ONLY : MPL_RECV, MPL_SEND, MPL_BARRIER, MPL_WAIT, & +USE MPL_MODULE ,ONLY : MPL_RECV, MPL_SEND, MPL_BARRIER, MPL_WAIT, & & JP_BLOCKING_STANDARD, JP_NON_BLOCKING_STANDARD -!USE TPM_GEN -!USE TPM_DIM -USE TPM_DISTR ,ONLY : MTAGDISTSP, NPRCIDS, NPRTRW, & - & MYSETV, MYSETW, MYPROC, NPROC +USE TPM_DISTR ,ONLY : MTAGDISTSP, NPRCIDS, NPRTRW, MYSETV, MYSETW, MYPROC, NPROC, NPRTRV USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS - USE SET2PE_MOD ,ONLY : SET2PE -!USE SUWAVEDI_MOD -! +USE TPM_GEOMETRY ,ONLY : G IMPLICIT NONE @@ -59,175 +76,234 @@ SUBROUTINE GATH_SPEC_CONTROL(PSPECG,KFGATHG,KTO,KVSET,PSPEC,LDIM1_IS_FLD,& LOGICAL ,OPTIONAL, INTENT(IN) :: LDIM1_IS_FLD INTEGER(KIND=JPIM) , INTENT(IN) :: KSMAX INTEGER(KIND=JPIM) , INTENT(IN) :: KSPEC2 -INTEGER(KIND=JPIM) , INTENT(IN) :: KSPEC2_G +INTEGER(KIND=JPIM) , INTENT(IN) :: KSPEC2MX +INTEGER(KIND=JPIM) , INTENT(IN) :: KSPEC2G INTEGER(KIND=JPIM) , INTENT(IN) :: KPOSSP(:) INTEGER(KIND=JPIM) , INTENT(IN) :: KDIM0G(0:) +INTEGER(KIND=JPIM) , INTENT(IN) :: KUMPP(NPRTRW) +INTEGER(KIND=JPIM) , INTENT(IN) :: KALLMS(KSMAX+1) +INTEGER(KIND=JPIM) , INTENT(IN) :: KPTRMS(NPRTRW) +INTEGER(KIND=JPIM) , INTENT(IN) :: KN(0:KSMAX) LOGICAL ,OPTIONAL, INTENT(IN) :: LDZA0IP -REAL(KIND=JPRB) :: ZFLD(KSPEC2,KFGATHG),ZDUM(KSPEC2) -REAL(KIND=JPRB),ALLOCATABLE :: ZRECV(:,:) -INTEGER(KIND=JPIM) :: JM,JN,II,IFLDR,IFLDS,JFLD,ITAG,IBSET,ILEN,JA,ISND -INTEGER(KIND=JPIM) :: IRCV,ISP,ILENR,ISTA,ISTP,ISENDREQ(KFGATHG),IPOS0,JNM -INTEGER(KIND=JPIM) :: IDIST(KSPEC2_G),IMYFIELDS +REAL(KIND=JPRB) :: ZBUFSEND(KSPEC2MX,COUNT(KVSET(1:KFGATHG) == MYSETV)) +REAL(KIND=JPRB) :: ZRECV(KSPEC2MX,COUNT(KTO(1:KFGATHG) == MYPROC)) +INTEGER(KIND=JPIM) :: IASM0G(0:KSMAX) +INTEGER(KIND=JPIM) :: JM,JN,II,IFLDR,IFLDS,JFLD,ITAG,IB,ILEN(NPRTRW),JA,JB,ISND,JMLOC +INTEGER(KIND=JPIM) :: IPE(NPRTRV,NPRTRW),ILENR,ISENDREQ(NPROC),IPOSSP,JNM,JROC +INTEGER(KIND=JPIM) :: IFLD,IFLDLOC(COUNT(KTO(1:KFGATHG) == MYPROC)),IOFFPROC +INTEGER(KIND=JPIM) :: ILOCFLD(COUNT(KVSET(1:KFGATHG) == MYSETV)) LOGICAL :: LLZA0IP ! ------------------------------------------------------------------ -LLZA0IP=.TRUE. +! Compute help array for distribution + +DO JA=1,NPRTRW + ILEN(JA) = KPOSSP(JA+1)-KPOSSP(JA) +ENDDO +DO JA=1,NPRTRW + DO JB=1,NPRTRV + CALL SET2PE(IPE(JB,JA),0,0,JA,JB) + ENDDO +ENDDO +IASM0G(0)=1 +DO JM=1,KSMAX + IASM0G(JM)=IASM0G(JM-1)+KN(JM-1) +ENDDO + +LLZA0IP=.NOT.G%LAM ! or it should have been coded in the original code, please :-( IF (PRESENT (LDZA0IP)) LLZA0IP=LDZA0IP !GATHER SPECTRAL ARRAY -IF( NPROC == 1 ) THEN - CALL GSTATS(1644,0) - IF(LDIM1_IS_FLD) THEN -!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JM,JFLD) - DO JM=1,KSPEC2_G +!Send +ISND=0 +IOFFPROC=0 +IF (KSPEC2 > 0) THEN + CALL GSTATS(810,0) + DO JROC=1,NPROC + IF (JROC /= MYPROC) THEN + IFLD=0 ! counter of fields in PSPEC + IFLDS=0 ! counter of fields in ZBUFSEND DO JFLD=1,KFGATHG - PSPECG(JFLD,JM) =PSPEC(JFLD,JM) + IF (KVSET(JFLD) == MYSETV) THEN + IFLD=IFLD+1 + IF (JROC==KTO(JFLD)) THEN + IFLDS=IFLDS+1 + IF (LDIM1_IS_FLD) THEN + ZBUFSEND(1:KSPEC2,IOFFPROC+IFLDS)=PSPEC(IFLD,1:KSPEC2) + ELSE + ZBUFSEND(1:KSPEC2,IOFFPROC+IFLDS)=PSPEC(1:KSPEC2,IFLD) + ENDIF + ENDIF + ENDIF + ENDDO + IF (IFLDS > 0) THEN + ITAG=MTAGDISTSP+MYPROC + ISND=ISND+1 + CALL MPL_SEND(ZBUFSEND(:,IOFFPROC+1:IOFFPROC+IFLDS),KDEST=NPRCIDS(JROC),KTAG=ITAG,& + & KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=ISENDREQ(ISND),& + & CDSTRING='GATH_SPEC_CONTROL') + ENDIF + IOFFPROC=IOFFPROC+IFLDS + ENDIF + ENDDO + CALL GSTATS(810,1) + +! Myself : + IFLD=0 + IFLDR=0 + DO JFLD=1,KFGATHG + IF (KTO(JFLD) == MYPROC) THEN + IFLD=IFLD+1 + IF (KVSET(JFLD)==MYSETV) THEN + IFLDR = IFLDR+1 + IFLDLOC(IFLDR)=IFLD + ENDIF + ENDIF + ENDDO + IFLD=0 + IFLDR=0 + DO JFLD=1,KFGATHG + IF (KVSET(JFLD)==MYSETV) THEN + IFLD=IFLD+1 + IF (KTO(JFLD) == MYPROC) THEN + IFLDR = IFLDR+1 + ILOCFLD(IFLDR)=IFLD + ENDIF + ENDIF + ENDDO + IF (IFLDR > 0) THEN + IF (LDIM1_IS_FLD) THEN + CALL GSTATS(1644,0) +!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JFLD,JMLOC,JM,IPOSSP,II,JN) + DO JFLD=1,IFLDR + DO JMLOC=1,KUMPP(MYSETW) + JM=KALLMS(KPTRMS(MYSETW)+JMLOC-1) + IPOSSP=KDIM0G(JM)-KPOSSP(MYSETW)+1 + PSPECG(IFLDLOC(JFLD),IASM0G(JM):IASM0G(JM)+KN(JM)-1)=PSPEC(ILOCFLD(JFLD),IPOSSP:IPOSSP+KN(JM)-1) + ENDDO + IF (LLZA0IP) THEN + II = 0 + DO JN=0,KSMAX + II = II+2 + PSPECG(IFLDLOC(JFLD),II) = 0.0_JPRB + ENDDO + ENDIF ENDDO - ENDDO !$OMP END PARALLEL DO - ELSE -!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JM,JFLD) - DO JFLD=1,KFGATHG - DO JM=1,KSPEC2_G - PSPECG(JM,JFLD) =PSPEC(JM,JFLD) + CALL GSTATS(1644,1) + ELSE + CALL GSTATS(1644,0) +!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JFLD,JMLOC,JM,IPOSSP,II,JN) + DO JFLD=1,IFLDR + DO JMLOC=1,KUMPP(MYSETW) + JM=KALLMS(KPTRMS(MYSETW)+JMLOC-1) + IPOSSP=KDIM0G(JM)-KPOSSP(MYSETW)+1 + PSPECG(IASM0G(JM):IASM0G(JM)+KN(JM)-1,IFLDLOC(JFLD))=PSPEC(IPOSSP:IPOSSP+KN(JM)-1,ILOCFLD(JFLD)) + ENDDO + IF (LLZA0IP) THEN + II = 0 + DO JN=0,KSMAX + II = II+2 + PSPECG(II,IFLDLOC(JFLD)) = 0.0_JPRB + ENDDO + ENDIF ENDDO - ENDDO !$OMP END PARALLEL DO - ENDIF - CALL GSTATS(1644,1) -ELSE - IMYFIELDS = 0 - DO JFLD=1,KFGATHG - IF(KTO(JFLD) == MYPROC) THEN - IMYFIELDS = IMYFIELDS+1 + CALL GSTATS(1644,1) ENDIF - ENDDO - IF(IMYFIELDS>0) THEN - ALLOCATE(ZRECV(KSPEC2_G,IMYFIELDS)) - II = 0 - CALL GSTATS(1804,0) - DO JM=0,KSMAX - DO JN=JM,KSMAX - IDIST(II+1) = KDIM0G(JM)+(JN-JM)*2 - IDIST(II+2) = KDIM0G(JM)+(JN-JM)*2+1 - II = II+2 - ENDDO - ENDDO - CALL GSTATS(1804,1) ENDIF - CALL GSTATS_BARRIER(788) - - !Send - CALL GSTATS(810,0) - IFLDS = 0 - IF(KSPEC2 > 0 )THEN - DO JFLD=1,KFGATHG - - IBSET = KVSET(JFLD) - IF( IBSET == MYSETV )THEN - - IFLDS = IFLDS+1 - ISND = KTO(JFLD) - ITAG = MTAGDISTSP+JFLD+17 - IF(LDIM1_IS_FLD) THEN - ZFLD(1:KSPEC2,IFLDS)=PSPEC(IFLDS,1:KSPEC2) - CALL MPL_SEND(ZFLD(1:KSPEC2,IFLDS),KDEST=NPRCIDS(ISND),KTAG=ITAG,& - &KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=ISENDREQ(JFLD),& - &CDSTRING='GATH_SPEC_CONTROL') - ELSE - CALL MPL_SEND(PSPEC(1:KSPEC2,IFLDS),KDEST=NPRCIDS(ISND),KTAG=ITAG,& - &KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=ISENDREQ(JFLD),& - &CDSTRING='GATH_SPEC_CONTROL') - ENDIF - ENDIF - ENDDO - ENDIF +ENDIF - ! Recieve - IFLDR = 0 - DO JFLD=1,KFGATHG - IF(KTO(JFLD) == MYPROC) THEN - IBSET = KVSET(JFLD) - IFLDR = IFLDR+1 - DO JA=1,NPRTRW - ILEN = KPOSSP(JA+1)-KPOSSP(JA) - IF( ILEN > 0 )THEN - CALL SET2PE(IRCV,0,0,JA,IBSET) - ITAG = MTAGDISTSP+JFLD+17 - ISTA = KPOSSP(JA) - ISTP = ISTA+ILEN-1 - CALL MPL_RECV(ZRECV(ISTA:ISTP,IFLDR),KSOURCE=NPRCIDS(IRCV),KTAG=ITAG,& - &KMP_TYPE=JP_BLOCKING_STANDARD,KOUNT=ILENR, & - &CDSTRING='GATH_SPEC_CONTROL') - IF( ILENR /= ILEN )THEN - WRITE(0,'("GATH_SPEC_CONTROL: JFLD=",I4," JA=",I4," ILEN=",I10," ILENR=",I10)')& - &JFLD,JA,ILEN,ILENR +! Receive +DO JA=1,NPRTRW + IF (ILEN(JA) > 0) THEN + DO JB=1,NPRTRV + IF (IPE(JB,JA) /= MYPROC) THEN + ! Locate received fields in source array : + IFLD=0 + IFLDR=0 + DO JFLD=1,KFGATHG + IF (KTO(JFLD) == MYPROC) THEN + IFLD=IFLD+1 + IF (KVSET(JFLD)==JB) THEN + IFLDR = IFLDR+1 + IFLDLOC(IFLDR)=IFLD + ENDIF + ENDIF + ENDDO + IF (IFLDR > 0) THEN + ITAG=MTAGDISTSP+IPE(JB,JA) + CALL GSTATS(810,0) + CALL MPL_RECV(ZRECV(:,1:IFLDR),KSOURCE=NPRCIDS(IPE(JB,JA)),KTAG=ITAG,& + & KMP_TYPE=JP_BLOCKING_STANDARD,KOUNT=ILENR, & + & CDSTRING='GATH_SPEC_CONTROL') + IF (ILENR /= KSPEC2MX*IFLDR) THEN CALL ABORT_TRANS('GATH_SPEC_CONTROL:INVALID RECEIVE MESSAGE LENGTH') ENDIF + CALL GSTATS(810,1) + CALL GSTATS(1644,0) + IF (LDIM1_IS_FLD) THEN +!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JFLD,JMLOC,JM,IPOSSP,II,JN) + DO JFLD=1,IFLDR + DO JMLOC=1,KUMPP(JA) + JM=KALLMS(KPTRMS(JA)+JMLOC-1) + IPOSSP=KDIM0G(JM)-KPOSSP(JA)+1 + PSPECG(IFLDLOC(JFLD),IASM0G(JM):IASM0G(JM)+KN(JM)-1)=ZRECV(IPOSSP:IPOSSP+KN(JM)-1,JFLD) + ENDDO + IF (LLZA0IP) THEN + II = 0 + DO JN=0,KSMAX + II = II+2 + PSPECG(IFLDLOC(JFLD),II) = 0.0_JPRB + ENDDO + ENDIF + ENDDO +!$OMP END PARALLEL DO + ELSE +!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JFLD,JMLOC,JM,IPOSSP,II,JN) + DO JFLD=1,IFLDR + DO JMLOC=1,KUMPP(JA) + JM=KALLMS(KPTRMS(JA)+JMLOC-1) + IPOSSP=KDIM0G(JM)-KPOSSP(JA)+1 + PSPECG(IASM0G(JM):IASM0G(JM)+KN(JM)-1,IFLDLOC(JFLD))=ZRECV(IPOSSP:IPOSSP+KN(JM)-1,JFLD) + ENDDO + IF (LLZA0IP) THEN + II = 0 + DO JN=0,KSMAX + II = II+2 + PSPECG(II,IFLDLOC(JFLD)) = 0.0_JPRB + ENDDO + ENDIF + ENDDO +!$OMP END PARALLEL DO + ENDIF + CALL GSTATS(1644,1) ENDIF - ENDDO - ENDIF - ENDDO - - ! Check for completion of sends - IF(KSPEC2 > 0 )THEN - DO JFLD=1,KFGATHG - IBSET = KVSET(JFLD) - IF( IBSET == MYSETV )THEN - CALL MPL_WAIT(KREQUEST=ISENDREQ(JFLD), & - & CDSTRING='GATH_GRID_CTL: WAIT') ENDIF ENDDO ENDIF - CALL GSTATS(810,1) - CALL GSTATS_BARRIER2(788) - - CALL GSTATS(1644,0) -!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JFLD,JNM,II,JN,ISP) - DO JFLD=1,IMYFIELDS - IF(LDIM1_IS_FLD) THEN - DO JNM=1,KSPEC2_G - PSPECG(JFLD,JNM) = ZRECV(IDIST(JNM),JFLD) - ENDDO - IF (LLZA0IP) THEN - II = 0 - DO JN=0,KSMAX - ISP = KDIM0G(0)+JN*2+1 - II = II+2 - PSPECG(JFLD,II) = 0.0_JPRB - ENDDO - ENDIF - ELSE - DO JNM=1,KSPEC2_G - PSPECG(JNM,JFLD) = ZRECV(IDIST(JNM),JFLD) - ENDDO - IF (LLZA0IP) THEN - II = 0 - DO JN=0,KSMAX - ISP = KDIM0G(0)+JN*2+1 - II = II+2 - PSPECG(II,JFLD) = 0.0_JPRB - ENDDO - ENDIF - ENDIF - ENDDO -!$OMP END PARALLEL DO - CALL GSTATS(1644,1) - IF(ALLOCATED(ZRECV)) DEALLOCATE(ZRECV) +ENDDO +CALL GSTATS_BARRIER2(788) - !Synchronize processors - CALL GSTATS(785,0) - CALL MPL_BARRIER(CDSTRING='GATH_SPEC_CONTROL:') - CALL GSTATS(785,1) +! Check for completion of sends +CALL GSTATS(810,0) +IF (ISND > 0) THEN + CALL MPL_WAIT(ISENDREQ(1:ISND),CDSTRING='GATH_GRID_CTL: WAIT') ENDIF +CALL GSTATS(810,1) + +!Synchronize processors. Useful ?? +CALL GSTATS(785,0) +!rekCALL MPL_BARRIER(CDSTRING='GATH_SPEC_CONTROL:') +CALL GSTATS(785,1) + +CALL GSTATS_BARRIER(788) ! ------------------------------------------------------------------ END SUBROUTINE GATH_SPEC_CONTROL END MODULE GATH_SPEC_CONTROL_MOD - - diff --git a/src/trans/internal/gpnorm_trans_ctl_mod.F90 b/src/trans/internal/gpnorm_trans_ctl_mod.F90 index 13b236908..4c18db54b 100644 --- a/src/trans/internal/gpnorm_trans_ctl_mod.F90 +++ b/src/trans/internal/gpnorm_trans_ctl_mod.F90 @@ -48,6 +48,7 @@ SUBROUTINE GPNORM_TRANS_CTL(PGP,KFIELDS,KPROMA,PAVE,PMIN,PMAX,LDAVE_ONLY,PW) ! Original : 19th Sept 2008 ! R. El Khatib 07-08-2009 Optimisation directive for NEC ! R. El Khatib 16-Sep-2019 merge with LAM code +! R. El Khatib 02-Jun-2022 Optimization/Cleaning ! ------------------------------------------------------------------ USE PARKIND1 ,ONLY : JPIM ,JPRB, JPRD @@ -154,6 +155,7 @@ SUBROUTINE GPNORM_TRANS_CTL(PGP,KFIELDS,KPROMA,PAVE,PMIN,PMAX,LDAVE_ONLY,PW) ENDDO ALLOCATE(ZGTF(IF_FS,D%NLENGTF)) +IF (SIZE(ZGTF) > 0) ZGTF(1,1)=0._JPRB ! force allocation right here, not inside an omp region below LGPNORM=.TRUE. CALL TRGTOL(ZGTF,IF_FS,IF_GP,IF_SCALARS_G,IVSET,PGP=PGP) LGPNORM=.FALSE. diff --git a/src/trans/internal/tpm_gen.F90 b/src/trans/internal/tpm_gen.F90 index 16e896978..f2ac76b4f 100644 --- a/src/trans/internal/tpm_gen.F90 +++ b/src/trans/internal/tpm_gen.F90 @@ -39,6 +39,11 @@ MODULE TPM_GEN ! 2 = Use buffered SENDs, use blocking RECVs, add barrier at the end of each cycle INTEGER(KIND=JPIM) :: NTRANS_SYNC_LEVEL = 0 +! NSTACK_MEMORY_TR : optional memory strategy in gridpoint transpositions +! = 0 : prefer heap (slower but less memory consuming) +! > 0 : prefer stack (faster but more memory consuming) +INTEGER(KIND=JPIM) :: NSTACK_MEMORY_TR = 0 + LOGICAL, ALLOCATABLE :: LENABLED(:) ! true: the resolution is enabled (it has been ! initialised and has not been released afterward) diff --git a/src/trans/internal/trgtol_mod.F90 b/src/trans/internal/trgtol_mod.F90 index 042d8d566..0732eddd5 100644 --- a/src/trans/internal/trgtol_mod.F90 +++ b/src/trans/internal/trgtol_mod.F90 @@ -11,7 +11,7 @@ MODULE TRGTOL_MOD PUBLIC TRGTOL -PRIVATE TRGTOL_PROLOG, TRGTOL_COMM +PRIVATE TRGTOL_PROLOG, TRGTOL_COMM, TRGTOL_COMM_HEAP, TRGTOL_COMM_STACK CONTAINS @@ -50,11 +50,13 @@ SUBROUTINE TRGTOL(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,KPTRGP,& ! Modifications. ! -------------- ! Original : 18-Aug-2014 from trgtol +! R. El Khatib 09-Sep-2020 NSTACK_MEMORY_TR ! ------------------------------------------------------------------ USE PARKIND1 ,ONLY : JPIM ,JPRB USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK +USE TPM_GEN ,ONLY : NSTACK_MEMORY_TR USE TPM_DISTR ,ONLY : D, NPRTRNS, NPROC USE TPM_TRANS ,ONLY : NGPBLKS @@ -91,9 +93,15 @@ SUBROUTINE TRGTOL(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,KPTRGP,& CALL TRGTOL_PROLOG(KF_FS,KF_GP,KVSET,& & ISENDCOUNT,IRECVCOUNT,INSEND,INRECV,ISENDTOT,IRECVTOT,ISEND,IRECV,IINDEX,INDOFF,IGPTRSEND) -CALL TRGTOL_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET, & - & ISENDCOUNT,IRECVCOUNT,INSEND,INRECV,ISENDTOT,IRECVTOT,ISEND,IRECV,IINDEX,INDOFF,IGPTRSEND, & - & KPTRGP,PGP,PGPUV,PGP3A,PGP3B,PGP2) +IF (NSTACK_MEMORY_TR==0) THEN + CALL TRGTOL_COMM_HEAP(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET, & + & ISENDCOUNT,IRECVCOUNT,INSEND,INRECV,ISENDTOT,IRECVTOT,ISEND,IRECV,IINDEX,INDOFF,IGPTRSEND, & + & KPTRGP,PGP,PGPUV,PGP3A,PGP3B,PGP2) +ELSE + CALL TRGTOL_COMM_STACK(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET, & + & ISENDCOUNT,IRECVCOUNT,INSEND,INRECV,ISENDTOT,IRECVTOT,ISEND,IRECV,IINDEX,INDOFF,IGPTRSEND, & + & KPTRGP,PGP,PGPUV,PGP3A,PGP3B,PGP2) +ENDIF IF (LHOOK) CALL DR_HOOK('TRGTOL',1,ZHOOK_HANDLE) @@ -257,8 +265,102 @@ SUBROUTINE TRGTOL_PROLOG(KF_FS,KF_GP,KVSET,& END SUBROUTINE TRGTOL_PROLOG +SUBROUTINE TRGTOL_COMM_HEAP(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& + & KSENDCOUNT,KRECVCOUNT,KNSEND,KNRECV,KSENDTOT,KRECVTOT,KSEND,KRECV,KINDEX,KNDOFF,KGPTRSEND,& + & KPTRGP,PGP,PGPUV,PGP3A,PGP3B,PGP2) + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE TPM_DISTR ,ONLY : D, NPRTRNS, NPROC +USE TPM_TRANS ,ONLY : NGPBLKS + +IMPLICIT NONE + +INTEGER(KIND=JPIM),INTENT(IN) :: KF_FS,KF_GP +REAL(KIND=JPRB),INTENT(OUT) :: PGLAT(KF_FS,D%NLENGTF) +INTEGER(KIND=JPIM),INTENT(IN) :: KVSET(KF_GP) +INTEGER(KIND=JPIM),INTENT(IN) :: KF_SCALARS_G +INTEGER(KIND=JPIM), INTENT(IN) :: KSENDCOUNT +INTEGER(KIND=JPIM), INTENT(IN) :: KRECVCOUNT +INTEGER(KIND=JPIM), INTENT(IN) :: KNSEND +INTEGER(KIND=JPIM), INTENT(IN) :: KNRECV +INTEGER(KIND=JPIM), INTENT(IN) :: KSENDTOT (NPROC) +INTEGER(KIND=JPIM), INTENT(IN) :: KRECVTOT (NPROC) +INTEGER(KIND=JPIM), INTENT(IN) :: KSEND (NPROC) +INTEGER(KIND=JPIM), INTENT(IN) :: KRECV (NPROC) +INTEGER(KIND=JPIM), INTENT(IN) :: KINDEX(D%NLENGTF) +INTEGER(KIND=JPIM), INTENT(IN) :: KNDOFF(NPROC) +INTEGER(KIND=JPIM), INTENT(IN) :: KGPTRSEND(2,NGPBLKS,NPRTRNS) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KPTRGP(:) +REAL(KIND=JPRB),OPTIONAL,INTENT(IN) :: PGP(:,:,:) +REAL(KIND=JPRB),OPTIONAL,INTENT(IN) :: PGPUV(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL,INTENT(IN) :: PGP3A(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL,INTENT(IN) :: PGP3B(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL,INTENT(IN) :: PGP2(:,:,:) + +REAL(KIND=JPRB), ALLOCATABLE :: ZCOMBUFS(:,:) +REAL(KIND=JPRB), ALLOCATABLE :: ZCOMBUFR(:,:) + +ALLOCATE(ZCOMBUFS(-1:KSENDCOUNT,KNSEND)) +! Now, force the OS to allocate this shared array right now, not when it starts to be used which is +! an OPEN-MP loop, that would cause a threads synchronization lock : +IF (KNSEND > 0 .AND. KSENDCOUNT >=-1) ZCOMBUFS(-1,1)=HUGE(1._JPRB) +ALLOCATE(ZCOMBUFR(-1:KRECVCOUNT,KNRECV)) + +CALL TRGTOL_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& + & KSENDCOUNT,KRECVCOUNT,KNSEND,KNRECV,KSENDTOT,KRECVTOT,KSEND,KRECV,KINDEX,KNDOFF,KGPTRSEND,& + & ZCOMBUFS,ZCOMBUFR, & + & KPTRGP,PGP,PGPUV,PGP3A,PGP3B,PGP2) + +DEALLOCATE(ZCOMBUFR) +DEALLOCATE(ZCOMBUFS) + +END SUBROUTINE TRGTOL_COMM_HEAP + +SUBROUTINE TRGTOL_COMM_STACK(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& + & KSENDCOUNT,KRECVCOUNT,KNSEND,KNRECV,KSENDTOT,KRECVTOT,KSEND,KRECV,KINDEX,KNDOFF,KGPTRSEND,& + & KPTRGP,PGP,PGPUV,PGP3A,PGP3B,PGP2) + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE TPM_DISTR ,ONLY : D, NPRTRNS, NPROC +USE TPM_TRANS ,ONLY : NGPBLKS + +IMPLICIT NONE + +INTEGER(KIND=JPIM),INTENT(IN) :: KF_FS,KF_GP +REAL(KIND=JPRB),INTENT(OUT) :: PGLAT(KF_FS,D%NLENGTF) +INTEGER(KIND=JPIM),INTENT(IN) :: KVSET(KF_GP) +INTEGER(KIND=JPIM),INTENT(IN) :: KF_SCALARS_G +INTEGER(KIND=JPIM), INTENT(IN) :: KSENDCOUNT +INTEGER(KIND=JPIM), INTENT(IN) :: KRECVCOUNT +INTEGER(KIND=JPIM), INTENT(IN) :: KNSEND +INTEGER(KIND=JPIM), INTENT(IN) :: KNRECV +INTEGER(KIND=JPIM), INTENT(IN) :: KSENDTOT (NPROC) +INTEGER(KIND=JPIM), INTENT(IN) :: KRECVTOT (NPROC) +INTEGER(KIND=JPIM), INTENT(IN) :: KSEND (NPROC) +INTEGER(KIND=JPIM), INTENT(IN) :: KRECV (NPROC) +INTEGER(KIND=JPIM), INTENT(IN) :: KINDEX(D%NLENGTF) +INTEGER(KIND=JPIM), INTENT(IN) :: KNDOFF(NPROC) +INTEGER(KIND=JPIM), INTENT(IN) :: KGPTRSEND(2,NGPBLKS,NPRTRNS) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KPTRGP(:) +REAL(KIND=JPRB),OPTIONAL,INTENT(IN) :: PGP(:,:,:) +REAL(KIND=JPRB),OPTIONAL,INTENT(IN) :: PGPUV(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL,INTENT(IN) :: PGP3A(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL,INTENT(IN) :: PGP3B(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL,INTENT(IN) :: PGP2(:,:,:) + +REAL(KIND=JPRB) :: ZCOMBUFS(-1:KSENDCOUNT,KNSEND) +REAL(KIND=JPRB) :: ZCOMBUFR(-1:KRECVCOUNT,KNRECV) + +CALL TRGTOL_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& + & KSENDCOUNT,KRECVCOUNT,KNSEND,KNRECV,KSENDTOT,KRECVTOT,KSEND,KRECV,KINDEX,KNDOFF,KGPTRSEND,& + & ZCOMBUFS,ZCOMBUFR, & + & KPTRGP,PGP,PGPUV,PGP3A,PGP3B,PGP2) + +END SUBROUTINE TRGTOL_COMM_STACK + SUBROUTINE TRGTOL_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& & KSENDCOUNT,KRECVCOUNT,KNSEND,KNRECV,KSENDTOT,KRECVTOT,KSEND,KRECV,KINDEX,KNDOFF,KGPTRSEND,& + & PCOMBUFS,PCOMBUFR, & & KPTRGP,PGP,PGPUV,PGP3A,PGP3B,PGP2) !**** *TRGTOL_COMM * - transposition of grid point data from column @@ -304,7 +406,7 @@ SUBROUTINE TRGTOL_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& ! : 98-06-17 add mailbox control logic (from TRLTOM) ! =99-03-29= Mats Hamrud and Deborah Salmond ! JUMP in FFT's changed to 1 -! KINDEX introduced and ZCOMBUF not used for same PE +! KINDEX introduced and PCOMBUF not used for same PE ! 01-11-23 Deborah Salmond and John Hague ! LIMP_NOOLAP Option for non-overlapping message passing ! and buffer packing @@ -313,11 +415,12 @@ SUBROUTINE TRGTOL_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& ! 03-04-02 G. Radnoti: call barrier always when nproc>1 ! 08-01-01 G.Mozdzynski: cleanup ! 09-01-02 G.Mozdzynski: use non-blocking recv and send +! R. El Khatib 09-Sep-2020 64 bits addressing for PGLAT ! ------------------------------------------------------------------ -USE PARKIND1 ,ONLY : JPIM ,JPRB +USE PARKIND1 ,ONLY : JPIM ,JPRB ,JPIA USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK USE MPL_MODULE ,ONLY : MPL_RECV, MPL_SEND, MPL_WAIT, JP_NON_BLOCKING_STANDARD, MPL_WAITANY, & @@ -349,6 +452,8 @@ SUBROUTINE TRGTOL_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& INTEGER(KIND=JPIM), INTENT(IN) :: KINDEX(D%NLENGTF) INTEGER(KIND=JPIM), INTENT(IN) :: KNDOFF(NPROC) INTEGER(KIND=JPIM), INTENT(IN) :: KGPTRSEND(2,NGPBLKS,NPRTRNS) +REAL(KIND=JPRB), INTENT(INOUT) :: PCOMBUFS(-1:KSENDCOUNT,KNSEND) +REAL(KIND=JPRB), INTENT(INOUT) :: PCOMBUFR(-1:KRECVCOUNT,KNRECV) INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KPTRGP(:) REAL(KIND=JPRB),OPTIONAL,INTENT(IN) :: PGP(:,:,:) REAL(KIND=JPRB),OPTIONAL,INTENT(IN) :: PGPUV(:,:,:,:) @@ -356,9 +461,6 @@ SUBROUTINE TRGTOL_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& REAL(KIND=JPRB),OPTIONAL,INTENT(IN) :: PGP3B(:,:,:,:) REAL(KIND=JPRB),OPTIONAL,INTENT(IN) :: PGP2(:,:,:) -REAL(KIND=JPRB), ALLOCATABLE :: ZCOMBUFS(:,:) -REAL(KIND=JPRB), ALLOCATABLE :: ZCOMBUFR(:,:) - INTEGER(KIND=JPIM) :: IPOSPLUS(KNSEND) INTEGER(KIND=JPIM) :: ISETW(KNSEND) INTEGER(KIND=JPIM) :: IJPOS(NGPBLKS,KNSEND) @@ -375,6 +477,8 @@ SUBROUTINE TRGTOL_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& INTEGER(KIND=JPIM) :: ISEND, ITAG, JBLK, JFLD, JK, JL, IFLD, II, IFLDS, INS, INR INTEGER(KIND=JPIM) :: JJ,JI,IFLDT, J +INTEGER(KIND=JPIA) :: JFLD64 + INTEGER(KIND=JPIM) :: IUVLEVS(KF_GP),IUVPARS(KF_GP),IGP2PARS(KF_GP) INTEGER(KIND=JPIM) :: IGP3APARS(KF_GP),IGP3ALEVS(KF_GP),IGP3BPARS(KF_GP),IGP3BLEVS(KF_GP) INTEGER(KIND=JPIM) :: IUVPAR,IUVLEV,IGP2PAR,IGP3ALEV,IGP3APAR,IGP3BLEV,IGP3BPAR,IPAROFF @@ -394,8 +498,6 @@ SUBROUTINE TRGTOL_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& ITAG = MTAGGL IF (LHOOK) CALL DR_HOOK('TRGTOL_BAR',0,ZHOOK_HANDLE_BAR) -ALLOCATE(ZCOMBUFS(-1:KSENDCOUNT,KNSEND)) -ALLOCATE(ZCOMBUFR(-1:KRECVCOUNT,KNRECV)) CALL GSTATS_BARRIER(761) IF (LHOOK) CALL DR_HOOK('TRGTOL_BAR',1,ZHOOK_HANDLE_BAR) @@ -409,7 +511,7 @@ SUBROUTINE TRGTOL_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& ! Receive loop......................................................... DO INR=1,KNRECV IRECV=KRECV(INR) - CALL MPL_RECV(ZCOMBUFR(-1:KRECVTOT(IRECV),INR), & + CALL MPL_RECV(PCOMBUFR(-1:KRECVTOT(IRECV),INR), & & KSOURCE=NPRCIDS(IRECV), & & KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=IREQ_RECV(INR), & & KTAG=ITAG,CDSTRING='TRGTOL_COMM: NON-BLOCKING IRECV' ) @@ -626,44 +728,56 @@ SUBROUTINE TRGTOL_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& ENDIF ENDDO CALL GSTATS(1601,0) -!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JFLD,JBLK,JK,IFLD,IPOS,IFIRST,ILAST) +#ifdef __NEC__ +! Loops inversion is still better on Aurora machines, according to CHMI. REK. +!$OMP PARALLEL DO SCHEDULE(DYNAMIC) PRIVATE(JFLD64,JBLK,JK,IFLD,IPOS,IFIRST,ILAST) +#else +!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JFLD64,JBLK,JK,IFLD,IPOS,IFIRST,ILAST) +#endif DO JBLK=1,NGPBLKS IFIRST = KGPTRSEND(1,JBLK,MYSETW) IF(IFIRST > 0) THEN ILAST = KGPTRSEND(2,JBLK,MYSETW) +! Address PGLAT over 64 bits because its size may exceed 2 GB for big data and +! small number of tasks. IF(LLPGPONLY) THEN - DO JFLD=1,IFLDS - IFLD = IFLDOFF(JFLD) + DO JFLD64=1,IFLDS + IFLD = IFLDOFF(JFLD64) +!DIR$ VECTOR ALWAYS DO JK=IFIRST,ILAST IPOS = KNDOFF(MYPROC)+IGPTROFF(JBLK)+JK-IFIRST+1 - PGLAT(JFLD,KINDEX(IPOS)) = PGP(JK,IFLD,JBLK) + PGLAT(JFLD64,KINDEX(IPOS)) = PGP(JK,IFLD,JBLK) ENDDO ENDDO ELSE - DO JFLD=1,IFLDS - IFLD = IFLDOFF(JFLD) + DO JFLD64=1,IFLDS + IFLD = IFLDOFF(JFLD64) IF(LLUV(IFLD)) THEN +!DIR$ VECTOR ALWAYS DO JK=IFIRST,ILAST IPOS = KNDOFF(MYPROC)+IGPTROFF(JBLK)+JK-IFIRST+1 - PGLAT(JFLD,KINDEX(IPOS)) = PGPUV(JK,IUVLEVS(IFLD),IUVPARS(IFLD),JBLK) + PGLAT(JFLD64,KINDEX(IPOS)) = PGPUV(JK,IUVLEVS(IFLD),IUVPARS(IFLD),JBLK) ENDDO ELSEIF(LLGP2(IFLD)) THEN +!DIR$ VECTOR ALWAYS DO JK=IFIRST,ILAST IPOS = KNDOFF(MYPROC)+IGPTROFF(JBLK)+JK-IFIRST+1 - PGLAT(JFLD,KINDEX(IPOS)) = PGP2(JK,IGP2PARS(IFLD),JBLK) + PGLAT(JFLD64,KINDEX(IPOS)) = PGP2(JK,IGP2PARS(IFLD),JBLK) ENDDO ELSEIF(LLGP3A(IFLD)) THEN +!DIR$ VECTOR ALWAYS DO JK=IFIRST,ILAST IPOS = KNDOFF(MYPROC)+IGPTROFF(JBLK)+JK-IFIRST+1 - PGLAT(JFLD,KINDEX(IPOS)) = PGP3A(JK,IGP3ALEVS(IFLD),IGP3APARS(IFLD),JBLK) + PGLAT(JFLD64,KINDEX(IPOS)) = PGP3A(JK,IGP3ALEVS(IFLD),IGP3APARS(IFLD),JBLK) ENDDO ELSEIF(LLGP3B(IFLD)) THEN +!DIR$ VECTOR ALWAYS DO JK=IFIRST,ILAST IPOS = KNDOFF(MYPROC)+IGPTROFF(JBLK)+JK-IFIRST+1 - PGLAT(JFLD,KINDEX(IPOS)) = PGP3B(JK,IGP3BLEVS(IFLD),IGP3BPARS(IFLD),JBLK) + PGLAT(JFLD64,KINDEX(IPOS)) = PGP3B(JK,IGP3BLEVS(IFLD),IGP3BPARS(IFLD),JBLK) ENDDO ELSE - WRITE(NOUT,*)'TRGTOL_MOD: ERROR',JFLD,IFLD + WRITE(NOUT,*)'TRGTOL_MOD: ERROR',JFLD64,IFLD CALL ABORT_TRANS('TRGTOL_MOD: ERROR') ENDIF ENDDO @@ -712,8 +826,8 @@ SUBROUTINE TRGTOL_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& ENDIF ENDDO - ZCOMBUFS(-1,INS) = 1 - ZCOMBUFS(0,INS) = IFLD + PCOMBUFS(-1,INS) = 1 + PCOMBUFS(0,INS) = IFLD ENDDO !$OMP END PARALLEL DO @@ -722,8 +836,8 @@ SUBROUTINE TRGTOL_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& ISEND=KSEND(INS) IPOS=IPOSPLUS(INS) - ISEND_FLD_START=ZCOMBUFS(-1,INS) - ISEND_FLD_END = ZCOMBUFS(0,INS) + ISEND_FLD_START=PCOMBUFS(-1,INS) + ISEND_FLD_END = PCOMBUFS(0,INS) !$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(IFLDT,JBLK,IFIRST,ILAST,JK,JJ,JI) DO JJ=ISEND_FLD_START,ISEND_FLD_END @@ -735,33 +849,33 @@ SUBROUTINE TRGTOL_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& IF(LLINDER) THEN DO JK=IFIRST,ILAST JI=(JJ-ISEND_FLD_START)*IPOS+IJPOS(JBLK,INS)+JK-IFIRST+1 - ZCOMBUFS(JI,INS) = PGP(JK,KPTRGP(IFLDT),JBLK) + PCOMBUFS(JI,INS) = PGP(JK,KPTRGP(IFLDT),JBLK) ENDDO ELSE IF(LLPGPONLY) THEN DO JK=IFIRST,ILAST JI=(JJ-ISEND_FLD_START)*IPOS+IJPOS(JBLK,INS)+JK-IFIRST+1 - ZCOMBUFS(JI,INS) = PGP(JK,IFLDT,JBLK) + PCOMBUFS(JI,INS) = PGP(JK,IFLDT,JBLK) ENDDO ELSEIF(LLUV(IFLDT)) THEN DO JK=IFIRST,ILAST JI=(JJ-ISEND_FLD_START)*IPOS+IJPOS(JBLK,INS)+JK-IFIRST+1 - ZCOMBUFS(JI,INS) = PGPUV(JK,IUVLEVS(IFLDT),IUVPARS(IFLDT),JBLK) + PCOMBUFS(JI,INS) = PGPUV(JK,IUVLEVS(IFLDT),IUVPARS(IFLDT),JBLK) ENDDO ELSEIF(LLGP2(IFLDT)) THEN DO JK=IFIRST,ILAST JI=(JJ-ISEND_FLD_START)*IPOS+IJPOS(JBLK,INS)+JK-IFIRST+1 - ZCOMBUFS(JI,INS) = PGP2(JK,IGP2PARS(IFLDT),JBLK) + PCOMBUFS(JI,INS) = PGP2(JK,IGP2PARS(IFLDT),JBLK) ENDDO ELSEIF(LLGP3A(IFLDT)) THEN DO JK=IFIRST,ILAST JI=(JJ-ISEND_FLD_START)*IPOS+IJPOS(JBLK,INS)+JK-IFIRST+1 - ZCOMBUFS(JI,INS) = PGP3A(JK,IGP3ALEVS(IFLDT),IGP3APARS(IFLDT),JBLK) + PCOMBUFS(JI,INS) = PGP3A(JK,IGP3ALEVS(IFLDT),IGP3APARS(IFLDT),JBLK) ENDDO ELSEIF(LLGP3B(IFLDT)) THEN DO JK=IFIRST,ILAST JI=(JJ-ISEND_FLD_START)*IPOS+IJPOS(JBLK,INS)+JK-IFIRST+1 - ZCOMBUFS(JI,INS) = PGP3B(JK,IGP3BLEVS(IFLDT),IGP3BPARS(IFLDT),JBLK) + PCOMBUFS(JI,INS) = PGP3B(JK,IGP3BLEVS(IFLDT),IGP3BPARS(IFLDT),JBLK) ENDDO ENDIF ENDIF @@ -771,11 +885,11 @@ SUBROUTINE TRGTOL_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& !$OMP END PARALLEL DO IF (NTRANS_SYNC_LEVEL <= 1) THEN - CALL MPL_SEND(ZCOMBUFS(-1:KSENDTOT(ISEND),INS),KDEST=NPRCIDS(ISEND), & + CALL MPL_SEND(PCOMBUFS(-1:KSENDTOT(ISEND),INS),KDEST=NPRCIDS(ISEND), & & KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=IREQ_SEND(INS), & & KTAG=ITAG,CDSTRING='TRGTOL_COMM: NON-BLOCKING ISEND' ) ELSE - CALL MPL_SEND(ZCOMBUFS(-1:KSENDTOT(ISEND),INS),KDEST=NPRCIDS(ISEND), & + CALL MPL_SEND(PCOMBUFS(-1:KSENDTOT(ISEND),INS),KDEST=NPRCIDS(ISEND), & & KMP_TYPE=JP_BLOCKING_BUFFERED, & & KTAG=ITAG,CDSTRING='TRGTOL_COMM: BLOCKING BUFFERED BSEND' ) ENDIF @@ -792,7 +906,7 @@ SUBROUTINE TRGTOL_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& ELSE INR = JNR IRECV=KRECV(INR) - CALL MPL_RECV(ZCOMBUFR(-1:KRECVTOT(IRECV),INR), & + CALL MPL_RECV(PCOMBUFR(-1:KRECVTOT(IRECV),INR), & & KSOURCE=NPRCIDS(IRECV), & & KMP_TYPE=JP_BLOCKING_STANDARD, & & KTAG=ITAG,CDSTRING='TRGTOL_COMM: BLOCKING RECV' ) @@ -800,13 +914,13 @@ SUBROUTINE TRGTOL_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& IRECV=KRECV(INR) ILEN = KRECVTOT(IRECV)/KF_FS - IRECV_FLD_START = ZCOMBUFR(-1,INR) - IRECV_FLD_END = ZCOMBUFR(0,INR) + IRECV_FLD_START = PCOMBUFR(-1,INR) + IRECV_FLD_END = PCOMBUFR(0,INR) !$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JL,II,JFLD) DO JL=1,ILEN II = KINDEX(KNDOFF(IRECV)+JL) DO JFLD=IRECV_FLD_START,IRECV_FLD_END - PGLAT(JFLD,II) = ZCOMBUFR(JL+(JFLD-IRECV_FLD_START)*ILEN,INR) + PGLAT(JFLD,II) = PCOMBUFR(JL+(JFLD-IRECV_FLD_START)*ILEN,INR) ENDDO ENDDO !$OMP END PARALLEL DO @@ -829,8 +943,6 @@ SUBROUTINE TRGTOL_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& CALL GSTATS(804,1) ENDIF -DEALLOCATE(ZCOMBUFR) -DEALLOCATE(ZCOMBUFS) CALL GSTATS_BARRIER2(761) END SUBROUTINE TRGTOL_COMM diff --git a/src/trans/internal/trltog_mod.F90 b/src/trans/internal/trltog_mod.F90 index d7731e327..49e675e01 100644 --- a/src/trans/internal/trltog_mod.F90 +++ b/src/trans/internal/trltog_mod.F90 @@ -11,7 +11,7 @@ MODULE TRLTOG_MOD PUBLIC TRLTOG -PRIVATE TRLTOG_PROLOG, TRLTOG_COMM +PRIVATE TRLTOG_PROLOG, TRLTOG_COMM, TRLTOG_COMM_HEAP, TRLTOG_COMM_STACK CONTAINS @@ -54,11 +54,13 @@ SUBROUTINE TRLTOG(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,KPTRGP,& ! Modifications. ! -------------- ! Original : 18-Aug-2014 from trltog +! R. El Khatib 09-Sep-2020 NSTACK_MEMORY_TR ! ------------------------------------------------------------------ USE PARKIND1 ,ONLY : JPIM ,JPRB USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK +USE TPM_GEN ,ONLY : NSTACK_MEMORY_TR USE TPM_DISTR ,ONLY : D, NPRTRNS, NPROC USE TPM_TRANS ,ONLY : NGPBLKS @@ -97,10 +99,17 @@ SUBROUTINE TRLTOG(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,KPTRGP,& CALL TRLTOG_PROLOG(KF_FS,KF_GP,KVSET,& & ISENDCOUNT,IRECVCOUNT,INSEND,INRECV,ISENDTOT,IRECVTOT,ISEND,IRECV,IINDEX,INDOFF,IGPTRSEND, & & ISETAL,ISETBL,ISETWL,ISETVL) -CALL TRLTOG_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET, & - & ISENDCOUNT,IRECVCOUNT,INSEND,INRECV,ISENDTOT,IRECVTOT,ISEND,IRECV,IINDEX,INDOFF,IGPTRSEND, & - & KPTRGP,PGP,PGPUV,PGP3A,PGP3B,PGP2,& - & ISETAL,ISETBL,ISETWL,ISETVL) +IF (NSTACK_MEMORY_TR==0) THEN + CALL TRLTOG_COMM_HEAP(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET, & + & ISENDCOUNT,IRECVCOUNT,INSEND,INRECV,ISENDTOT,IRECVTOT,ISEND,IRECV,IINDEX,INDOFF,IGPTRSEND, & + & KPTRGP,PGP,PGPUV,PGP3A,PGP3B,PGP2,& + & ISETAL,ISETBL,ISETWL,ISETVL) +ELSE + CALL TRLTOG_COMM_STACK(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET, & + & ISENDCOUNT,IRECVCOUNT,INSEND,INRECV,ISENDTOT,IRECVTOT,ISEND,IRECV,IINDEX,INDOFF,IGPTRSEND, & + & KPTRGP,PGP,PGPUV,PGP3A,PGP3B,PGP2,& + & ISETAL,ISETBL,ISETWL,ISETVL) +ENDIF IF (LHOOK) CALL DR_HOOK('TRLTOG',1,ZHOOK_HANDLE) @@ -270,8 +279,114 @@ SUBROUTINE TRLTOG_PROLOG(KF_FS,KF_GP,KVSET,& END SUBROUTINE TRLTOG_PROLOG +SUBROUTINE TRLTOG_COMM_HEAP(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& + & KSENDCOUNT,KRECVCOUNT,KNSEND,KNRECV,KSENDTOT,KRECVTOT,KSEND,KRECV,KINDEX,KNDOFF,KGPTRSEND,& + & KPTRGP,PGP,PGPUV,PGP3A,PGP3B,PGP2, & + & KSETAL, KSETBL,KSETWL,KSETVL) + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE TPM_DISTR ,ONLY : D, NPRTRNS, NPROC +USE TPM_TRANS ,ONLY : NGPBLKS + +IMPLICIT NONE + +INTEGER(KIND=JPIM), INTENT(IN) :: KF_FS,KF_GP +REAL(KIND=JPRB),INTENT(IN) :: PGLAT(KF_FS,D%NLENGTF) +INTEGER(KIND=JPIM), INTENT(IN) :: KVSET(KF_GP) +INTEGER(KIND=JPIM), INTENT(IN) :: KF_SCALARS_G +INTEGER(KIND=JPIM), INTENT(IN) :: KSENDCOUNT +INTEGER(KIND=JPIM), INTENT(IN) :: KRECVCOUNT +INTEGER(KIND=JPIM), INTENT(IN) :: KNSEND +INTEGER(KIND=JPIM), INTENT(IN) :: KNRECV +INTEGER(KIND=JPIM), INTENT(IN) :: KSENDTOT (NPROC) +INTEGER(KIND=JPIM), INTENT(IN) :: KRECVTOT (NPROC) +INTEGER(KIND=JPIM), INTENT(IN) :: KSEND (NPROC) +INTEGER(KIND=JPIM), INTENT(IN) :: KRECV (NPROC) +INTEGER(KIND=JPIM), INTENT(IN) :: KINDEX(D%NLENGTF) +INTEGER(KIND=JPIM), INTENT(IN) :: KNDOFF(NPROC) +INTEGER(KIND=JPIM), INTENT(IN) :: KGPTRSEND(2,NGPBLKS,NPRTRNS) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KPTRGP(:) +REAL(KIND=JPRB),OPTIONAL,INTENT(OUT) :: PGP(:,:,:) +REAL(KIND=JPRB),OPTIONAL,INTENT(OUT) :: PGPUV(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL,INTENT(OUT) :: PGP3A(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL,INTENT(OUT) :: PGP3B(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL,INTENT(OUT) :: PGP2(:,:,:) +INTEGER(KIND=JPIM), INTENT(IN) :: KSETAL(NPROC) +INTEGER(KIND=JPIM), INTENT(IN) :: KSETBL(NPROC) +INTEGER(KIND=JPIM), INTENT(IN) :: KSETWL(NPROC) +INTEGER(KIND=JPIM), INTENT(IN) :: KSETVL(NPROC) + +REAL(KIND=JPRB), ALLOCATABLE :: ZCOMBUFS(:,:) +REAL(KIND=JPRB), ALLOCATABLE :: ZCOMBUFR(:,:) + +ALLOCATE(ZCOMBUFS(-1:KSENDCOUNT,KNSEND)) +! Now, force the OS to allocate this shared array right now, not when it starts to be used which is +! an OPEN-MP loop, that would cause a threads synchronization lock : +IF (KNSEND > 0 .AND. KSENDCOUNT >=-1) ZCOMBUFS(-1,1)=HUGE(1._JPRB) +ALLOCATE(ZCOMBUFR(-1:KRECVCOUNT,KNRECV)) + +CALL TRLTOG_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& + & KSENDCOUNT,KRECVCOUNT,KNSEND,KNRECV,KSENDTOT,KRECVTOT,KSEND,KRECV,KINDEX,KNDOFF,KGPTRSEND,& + & ZCOMBUFS,ZCOMBUFR, & + & KPTRGP,PGP,PGPUV,PGP3A,PGP3B,PGP2, & + & KSETAL, KSETBL,KSETWL,KSETVL) + +DEALLOCATE(ZCOMBUFR) +DEALLOCATE(ZCOMBUFS) + +END SUBROUTINE TRLTOG_COMM_HEAP + +SUBROUTINE TRLTOG_COMM_STACK(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& + & KSENDCOUNT,KRECVCOUNT,KNSEND,KNRECV,KSENDTOT,KRECVTOT,KSEND,KRECV,KINDEX,KNDOFF,KGPTRSEND,& + & KPTRGP,PGP,PGPUV,PGP3A,PGP3B,PGP2, & + & KSETAL, KSETBL,KSETWL,KSETVL) + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE TPM_DISTR ,ONLY : D, NPRTRNS, NPROC +USE TPM_TRANS ,ONLY : NGPBLKS + +IMPLICIT NONE + +INTEGER(KIND=JPIM), INTENT(IN) :: KF_FS,KF_GP +REAL(KIND=JPRB),INTENT(IN) :: PGLAT(KF_FS,D%NLENGTF) +INTEGER(KIND=JPIM), INTENT(IN) :: KVSET(KF_GP) +INTEGER(KIND=JPIM), INTENT(IN) :: KF_SCALARS_G +INTEGER(KIND=JPIM), INTENT(IN) :: KSENDCOUNT +INTEGER(KIND=JPIM), INTENT(IN) :: KRECVCOUNT +INTEGER(KIND=JPIM), INTENT(IN) :: KNSEND +INTEGER(KIND=JPIM), INTENT(IN) :: KNRECV +INTEGER(KIND=JPIM), INTENT(IN) :: KSENDTOT (NPROC) +INTEGER(KIND=JPIM), INTENT(IN) :: KRECVTOT (NPROC) +INTEGER(KIND=JPIM), INTENT(IN) :: KSEND (NPROC) +INTEGER(KIND=JPIM), INTENT(IN) :: KRECV (NPROC) +INTEGER(KIND=JPIM), INTENT(IN) :: KINDEX(D%NLENGTF) +INTEGER(KIND=JPIM), INTENT(IN) :: KNDOFF(NPROC) +INTEGER(KIND=JPIM), INTENT(IN) :: KGPTRSEND(2,NGPBLKS,NPRTRNS) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KPTRGP(:) +REAL(KIND=JPRB),OPTIONAL,INTENT(OUT) :: PGP(:,:,:) +REAL(KIND=JPRB),OPTIONAL,INTENT(OUT) :: PGPUV(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL,INTENT(OUT) :: PGP3A(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL,INTENT(OUT) :: PGP3B(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL,INTENT(OUT) :: PGP2(:,:,:) +INTEGER(KIND=JPIM), INTENT(IN) :: KSETAL(NPROC) +INTEGER(KIND=JPIM), INTENT(IN) :: KSETBL(NPROC) +INTEGER(KIND=JPIM), INTENT(IN) :: KSETWL(NPROC) +INTEGER(KIND=JPIM), INTENT(IN) :: KSETVL(NPROC) + +REAL(KIND=JPRB) :: ZCOMBUFS(-1:KSENDCOUNT,KNSEND) +REAL(KIND=JPRB) :: ZCOMBUFR(-1:KRECVCOUNT,KNRECV) + +CALL TRLTOG_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& + & KSENDCOUNT,KRECVCOUNT,KNSEND,KNRECV,KSENDTOT,KRECVTOT,KSEND,KRECV,KINDEX,KNDOFF,KGPTRSEND,& + & ZCOMBUFS,ZCOMBUFR, & + & KPTRGP,PGP,PGPUV,PGP3A,PGP3B,PGP2, & + & KSETAL, KSETBL,KSETWL,KSETVL) + +END SUBROUTINE TRLTOG_COMM_STACK + SUBROUTINE TRLTOG_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& & KSENDCOUNT,KRECVCOUNT,KNSEND,KNRECV,KSENDTOT,KRECVTOT,KSEND,KRECV,KINDEX,KNDOFF,KGPTRSEND,& + & PCOMBUFS,PCOMBUFR, & & KPTRGP,PGP,PGPUV,PGP3A,PGP3B,PGP2, & & KSETAL, KSETBL,KSETWL,KSETVL) @@ -319,7 +434,7 @@ SUBROUTINE TRLTOG_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& ! to differ from NPRGPEW ! =99-03-29= Mats Hamrud and Deborah Salmond ! JUMP in FFT's changed to 1 -! KINDEX introduced and ZCOMBUF not used for same PE +! KINDEX introduced and PCOMBUF not used for same PE ! 01-11-23 Deborah Salmond and John Hague ! LIMP_NOOLAP Option for non-overlapping message passing ! and buffer packing @@ -328,9 +443,10 @@ SUBROUTINE TRLTOG_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& ! 03-0-02 G. Radnoti: Call barrier always when nproc>1 ! 08-01-01 G.Mozdzynski: cleanup ! 09-01-02 G.Mozdzynski: use non-blocking recv and send +! R. El Khatib 09-Sep-2020 64 bits addressing for PGLAT ! ------------------------------------------------------------------ -USE PARKIND1 ,ONLY : JPIM ,JPRB +USE PARKIND1 ,ONLY : JPIM ,JPRB ,JPIA USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK USE MPL_MODULE ,ONLY : MPL_RECV, MPL_SEND, MPL_WAIT, JP_NON_BLOCKING_STANDARD, MPL_WAITANY, & @@ -362,6 +478,8 @@ SUBROUTINE TRLTOG_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& INTEGER(KIND=JPIM), INTENT(IN) :: KINDEX(D%NLENGTF) INTEGER(KIND=JPIM), INTENT(IN) :: KNDOFF(NPROC) INTEGER(KIND=JPIM), INTENT(IN) :: KGPTRSEND(2,NGPBLKS,NPRTRNS) +REAL(KIND=JPRB), INTENT(INOUT) :: PCOMBUFS(-1:KSENDCOUNT,KNSEND) +REAL(KIND=JPRB), INTENT(INOUT) :: PCOMBUFR(-1:KRECVCOUNT,KNRECV) INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KPTRGP(:) REAL(KIND=JPRB),OPTIONAL,INTENT(OUT) :: PGP(:,:,:) REAL(KIND=JPRB),OPTIONAL,INTENT(OUT) :: PGPUV(:,:,:,:) @@ -375,9 +493,6 @@ SUBROUTINE TRLTOG_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& ! LOCAL VARIABLES -REAL(KIND=JPRB), ALLOCATABLE :: ZCOMBUFS(:,:) -REAL(KIND=JPRB), ALLOCATABLE :: ZCOMBUFR(:,:) - INTEGER(KIND=JPIM) :: IPOSPLUS(KNRECV) INTEGER(KIND=JPIM) :: ISETW(KNRECV) INTEGER(KIND=JPIM) :: JPOS(NGPBLKS,KNRECV) @@ -389,6 +504,8 @@ SUBROUTINE TRLTOG_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& INTEGER(KIND=JPIM) :: ISEND, ITAG, JBLK, JFLD, JK, JL, IFLDS, IPROC,JROC, INR, INS INTEGER(KIND=JPIM) :: II,ILEN,IBUFLENS,IBUFLENR, IFLDT, JI, JJ, J +INTEGER(KIND=JPIA) :: JFLD64 + LOGICAL :: LLPGPUV,LLPGP3A,LLPGP3B,LLPGP2,LLPGPONLY LOGICAL :: LLUV(KF_GP),LLGP2(KF_GP),LLGP3A(KF_GP),LLGP3B(KF_GP) LOGICAL :: LLINDER @@ -412,8 +529,6 @@ SUBROUTINE TRLTOG_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& ITAG = MTAGLG IF (LHOOK) CALL DR_HOOK('TRLTOG_BAR',0,ZHOOK_HANDLE_BAR) -ALLOCATE(ZCOMBUFS(-1:KSENDCOUNT,KNSEND)) -ALLOCATE(ZCOMBUFR(-1:KRECVCOUNT,KNRECV)) CALL GSTATS_BARRIER(762) IF (LHOOK) CALL DR_HOOK('TRLTOG_BAR',1,ZHOOK_HANDLE_BAR) @@ -423,7 +538,7 @@ SUBROUTINE TRLTOG_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& !...Receive loop......................................................... DO INR=1,KNRECV IRECV=KRECV(INR) - CALL MPL_RECV(ZCOMBUFR(-1:KRECVTOT(IRECV),INR), & + CALL MPL_RECV(PCOMBUFR(-1:KRECVTOT(IRECV),INR), & & KSOURCE=NPRCIDS(IRECV), & & KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=IREQ_RECV(INR), & & KTAG=ITAG,CDSTRING='TRLTOG_COMM: NON-BLOCKING IRECV' ) @@ -634,44 +749,56 @@ SUBROUTINE TRLTOG_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& ENDDO CALL GSTATS(1604,0) -!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JFLD,JBLK,JK,IFLD,IPOS,IFIRST,ILAST) +#ifdef __NEC__ +! Loops inversion is still better on Aurora machines, according to CHMI. REK. +!$OMP PARALLEL DO SCHEDULE(DYNAMIC) PRIVATE(JFLD64,JBLK,JK,IFLD,IPOS,IFIRST,ILAST) +#else +!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JFLD64,JBLK,JK,IFLD,IPOS,IFIRST,ILAST) +#endif DO JBLK=1,NGPBLKS IFIRST = KGPTRSEND(1,JBLK,MYSETW) IF(IFIRST > 0) THEN ILAST = KGPTRSEND(2,JBLK,MYSETW) +! Address PGLAT over 64 bits because its size may exceed 2 GB for big data and +! small number of tasks. IF(LLPGPONLY) THEN - DO JFLD=1,IFLDS - IFLD = IFLDOFF(JFLD) + DO JFLD64=1,IFLDS + IFLD = IFLDOFF(JFLD64) +!DIR$ VECTOR ALWAYS DO JK=IFIRST,ILAST IPOS = KNDOFF(MYPROC)+IGPTROFF(JBLK)+JK-IFIRST+1 - PGP(JK,IFLD,JBLK) = PGLAT(JFLD,KINDEX(IPOS)) + PGP(JK,IFLD,JBLK) = PGLAT(JFLD64,KINDEX(IPOS)) ENDDO ENDDO ELSE - DO JFLD=1,IFLDS - IFLD = IFLDOFF(JFLD) + DO JFLD64=1,IFLDS + IFLD = IFLDOFF(JFLD64) IF(LLUV(IFLD)) THEN +!DIR$ VECTOR ALWAYS DO JK=IFIRST,ILAST IPOS = KNDOFF(MYPROC)+IGPTROFF(JBLK)+JK-IFIRST+1 - PGPUV(JK,IUVLEVS(IFLD),IUVPARS(IFLD),JBLK) = PGLAT(JFLD,KINDEX(IPOS)) + PGPUV(JK,IUVLEVS(IFLD),IUVPARS(IFLD),JBLK) = PGLAT(JFLD64,KINDEX(IPOS)) ENDDO ELSEIF(LLGP2(IFLD)) THEN +!DIR$ VECTOR ALWAYS DO JK=IFIRST,ILAST IPOS = KNDOFF(MYPROC)+IGPTROFF(JBLK)+JK-IFIRST+1 - PGP2(JK,IGP2PARS(IFLD),JBLK)=PGLAT(JFLD,KINDEX(IPOS)) + PGP2(JK,IGP2PARS(IFLD),JBLK)=PGLAT(JFLD64,KINDEX(IPOS)) ENDDO ELSEIF(LLGP3A(IFLD)) THEN +!DIR$ VECTOR ALWAYS DO JK=IFIRST,ILAST IPOS = KNDOFF(MYPROC)+IGPTROFF(JBLK)+JK-IFIRST+1 - PGP3A(JK,IGP3ALEVS(IFLD),IGP3APARS(IFLD),JBLK)=PGLAT(JFLD,KINDEX(IPOS)) + PGP3A(JK,IGP3ALEVS(IFLD),IGP3APARS(IFLD),JBLK)=PGLAT(JFLD64,KINDEX(IPOS)) ENDDO ELSEIF(LLGP3B(IFLD)) THEN +!DIR$ VECTOR ALWAYS DO JK=IFIRST,ILAST IPOS = KNDOFF(MYPROC)+IGPTROFF(JBLK)+JK-IFIRST+1 - PGP3B(JK,IGP3BLEVS(IFLD),IGP3BPARS(IFLD),JBLK)=PGLAT(JFLD,KINDEX(IPOS)) + PGP3B(JK,IGP3BLEVS(IFLD),IGP3BPARS(IFLD),JBLK)=PGLAT(JFLD64,KINDEX(IPOS)) ENDDO ELSE - WRITE(NOUT,*)'TRLTOG_MOD: ERROR',JFLD,IFLD + WRITE(NOUT,*)'TRLTOG_MOD: ERROR',JFLD64,IFLD CALL ABORT_TRANS('TRLTOG_MOD: ERROR') ENDIF ENDDO @@ -703,18 +830,18 @@ SUBROUTINE TRLTOG_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& DO JL=1,ILEN II = KINDEX(KNDOFF(ISEND)+JL) DO JFLD=ISEND_FLD_START,ISEND_FLD_END - ZCOMBUFS((JFLD-ISEND_FLD_START)*ILEN+JL,INS) = PGLAT(JFLD,II) + PCOMBUFS((JFLD-ISEND_FLD_START)*ILEN+JL,INS) = PGLAT(JFLD,II) ENDDO ENDDO !$OMP END PARALLEL DO - ZCOMBUFS(-1,INS) = 1 - ZCOMBUFS(0,INS) = KF_FS + PCOMBUFS(-1,INS) = 1 + PCOMBUFS(0,INS) = KF_FS IF (NTRANS_SYNC_LEVEL <= 1) THEN - CALL MPL_SEND(ZCOMBUFS(-1:KSENDTOT(ISEND),INS),KDEST=NPRCIDS(ISEND),& + CALL MPL_SEND(PCOMBUFS(-1:KSENDTOT(ISEND),INS),KDEST=NPRCIDS(ISEND),& & KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=IREQ_SEND(INS), & & KTAG=ITAG,CDSTRING='TRLTOG_COMM: NON-BLOCKING ISEND') ELSE - CALL MPL_SEND(ZCOMBUFS(-1:KSENDTOT(ISEND),INS),KDEST=NPRCIDS(ISEND),& + CALL MPL_SEND(PCOMBUFS(-1:KSENDTOT(ISEND),INS),KDEST=NPRCIDS(ISEND),& & KMP_TYPE=JP_BLOCKING_BUFFERED, & & KTAG=ITAG,CDSTRING='TRLTOG_COMM: BLOCKING BUFFERED BSEND') ENDIF @@ -759,15 +886,15 @@ SUBROUTINE TRLTOG_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& ELSE INR = JNR IRECV=KRECV(INR) - CALL MPL_RECV(ZCOMBUFR(-1:KRECVTOT(IRECV),INR), & + CALL MPL_RECV(PCOMBUFR(-1:KRECVTOT(IRECV),INR), & & KSOURCE=NPRCIDS(IRECV), & & KMP_TYPE=JP_BLOCKING_STANDARD, & & KTAG=ITAG,CDSTRING='TRLTOG_COMM: BLOCKING RECV' ) ENDIF IPOS=IPOSPLUS(INR) - IRECV_FLD_START = ZCOMBUFR(-1,INR) - IRECV_FLD_END = ZCOMBUFR(0,INR) + IRECV_FLD_START = PCOMBUFR(-1,INR) + IRECV_FLD_END = PCOMBUFR(0,INR) !$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(IFLDT,IFIRST,ILAST,JK,JJ,JI,JBLK) DO JJ=IRECV_FLD_START,IRECV_FLD_END @@ -779,32 +906,32 @@ SUBROUTINE TRLTOG_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& IF(LLINDER) THEN DO JK=IFIRST,ILAST JI=(JJ-IRECV_FLD_START)*IPOS+JPOS(JBLK,INR)+JK-IFIRST+1 - PGP(JK,KPTRGP(IFLDT),JBLK) = ZCOMBUFR(JI,INR) + PGP(JK,KPTRGP(IFLDT),JBLK) = PCOMBUFR(JI,INR) ENDDO ELSEIF(LLPGPONLY) THEN DO JK=IFIRST,ILAST JI=(JJ-IRECV_FLD_START)*IPOS+JPOS(JBLK,INR)+JK-IFIRST+1 - PGP(JK,IFLDT,JBLK) = ZCOMBUFR(JI,INR) + PGP(JK,IFLDT,JBLK) = PCOMBUFR(JI,INR) ENDDO ELSEIF(LLUV(IFLDT)) THEN DO JK=IFIRST,ILAST JI=(JJ-IRECV_FLD_START)*IPOS+JPOS(JBLK,INR)+JK-IFIRST+1 - PGPUV(JK,IUVLEVS(IFLDT),IUVPARS(IFLDT),JBLK) = ZCOMBUFR(JI,INR) + PGPUV(JK,IUVLEVS(IFLDT),IUVPARS(IFLDT),JBLK) = PCOMBUFR(JI,INR) ENDDO ELSEIF(LLGP2(IFLDT)) THEN DO JK=IFIRST,ILAST JI=(JJ-IRECV_FLD_START)*IPOS+JPOS(JBLK,INR)+JK-IFIRST+1 - PGP2(JK,IGP2PARS(IFLDT),JBLK) = ZCOMBUFR(JI,INR) + PGP2(JK,IGP2PARS(IFLDT),JBLK) = PCOMBUFR(JI,INR) ENDDO ELSEIF(LLGP3A(IFLDT)) THEN DO JK=IFIRST,ILAST JI=(JJ-IRECV_FLD_START)*IPOS+JPOS(JBLK,INR)+JK-IFIRST+1 - PGP3A(JK,IGP3ALEVS(IFLDT),IGP3APARS(IFLDT),JBLK) = ZCOMBUFR(JI,INR) + PGP3A(JK,IGP3ALEVS(IFLDT),IGP3APARS(IFLDT),JBLK) = PCOMBUFR(JI,INR) ENDDO ELSEIF(LLGP3B(IFLDT)) THEN DO JK=IFIRST,ILAST JI=(JJ-IRECV_FLD_START)*IPOS+JPOS(JBLK,INR)+JK-IFIRST+1 - PGP3B(JK,IGP3BLEVS(IFLDT),IGP3BPARS(IFLDT),JBLK) = ZCOMBUFR(JI,INR) + PGP3B(JK,IGP3BLEVS(IFLDT),IGP3BPARS(IFLDT),JBLK) = PCOMBUFR(JI,INR) ENDDO ENDIF ENDIF @@ -825,8 +952,6 @@ SUBROUTINE TRLTOG_COMM(PGLAT,KF_FS,KF_GP,KF_SCALARS_G,KVSET,& CALL GSTATS(805,1) -DEALLOCATE(ZCOMBUFR) -DEALLOCATE(ZCOMBUFS) CALL GSTATS_BARRIER2(762) END SUBROUTINE TRLTOG_COMM From 5ba37a21d6411ac2d55cf98754dca2e9c972c67e Mon Sep 17 00:00:00 2001 From: EL KHATIB Ryad Date: Mon, 13 Nov 2023 11:24:09 +0000 Subject: [PATCH 02/25] Variable LALL_FFTW to perform fftw transforms in one bunch of all fields --- src/trans/external/setup_trans.F90 | 10 +++++++++- src/trans/include/ectrans/setup_trans.h | 4 +++- src/trans/internal/ftdir_mod.F90 | 5 ++--- src/trans/internal/ftdirad_mod.F90 | 5 ++--- src/trans/internal/ftinv_mod.F90 | 4 ++-- src/trans/internal/ftinvad_mod.F90 | 5 ++--- src/trans/internal/tpm_fftw.F90 | 10 ++++++---- 7 files changed, 26 insertions(+), 17 deletions(-) diff --git a/src/trans/external/setup_trans.F90 b/src/trans/external/setup_trans.F90 index 416db52b0..40e0689c3 100644 --- a/src/trans/external/setup_trans.F90 +++ b/src/trans/external/setup_trans.F90 @@ -10,7 +10,7 @@ SUBROUTINE SETUP_TRANS(KSMAX,KDGL,KDLON,KLOEN,LDSPLIT,PSTRET,& &KTMAX,KRESOL,PWEIGHT,LDGRIDONLY,LDUSERPNM,LDKEEPRPNM,LDUSEFLT,& -&LDSPSETUPONLY,LDPNMONLY,LDUSEFFTW,& +&LDSPSETUPONLY,LDPNMONLY,LDUSEFFTW,LD_ALL_FFTW,& &LDLL,LDSHIFTLL,CDIO_LEGPOL,CDLEGPOLFNAME,KLEGPOLPTR,KLEGPOLPTR_LEN) !**** *SETUP_TRANS* - Setup transform package for specific resolution @@ -52,6 +52,8 @@ SUBROUTINE SETUP_TRANS(KSMAX,KDGL,KDLON,KLOEN,LDSPLIT,PSTRET,& ! FLT, otherwise always kept) ! LDPNMONLY - Compute the Legendre polynomials only, not the FFTs. ! LDUSEFFTW - Use FFTW for FFTs +! LD_ALL_FFTW : T to transform all fields in one call, F to transforms fields one after another + ! LDLL - Setup second set of input/output latitudes ! the number of input/output latitudes to transform is equal KDGL ! or KDGL+2 in the case that includes poles + equator @@ -94,6 +96,7 @@ SUBROUTINE SETUP_TRANS(KSMAX,KDGL,KDLON,KLOEN,LDSPLIT,PSTRET,& ! G. Mozdzynski : Jun 2015 Support alternative FFTs to FFTW ! M.Hamrud/W.Deconinck : July 2015 IO options for Legenndre polynomials ! R. El Khatib 07-Mar-2016 Better flexibility for Legendre polynomials computation in stretched mode +! R. El Khatib 08-Jun-2023 LALL_FFTW for better flexibility ! ------------------------------------------------------------------ USE PARKIND1 ,ONLY : JPIM ,JPRB, JPRD @@ -141,6 +144,7 @@ SUBROUTINE SETUP_TRANS(KSMAX,KDGL,KDLON,KLOEN,LDSPLIT,PSTRET,& REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PSTRET LOGICAL ,OPTIONAL,INTENT(IN):: LDGRIDONLY LOGICAL ,OPTIONAL,INTENT(IN):: LDUSEFLT +LOGICAL ,OPTIONAL,INTENT(IN):: LD_ALL_FFTW LOGICAL ,OPTIONAL,INTENT(IN):: LDUSERPNM LOGICAL ,OPTIONAL,INTENT(IN):: LDKEEPRPNM LOGICAL ,OPTIONAL,INTENT(IN):: LDSPSETUPONLY @@ -228,6 +232,7 @@ SUBROUTINE SETUP_TRANS(KSMAX,KDGL,KDLON,KLOEN,LDSPLIT,PSTRET,& S%LUSEFLT=.FALSE. ! Use fast legendre transforms #ifdef WITH_FFTW TW%LFFTW=.FALSE. ! Use FFTW interface for FFTs +TW%LALL_FFTW=.FALSE. ! transform fields one at a time #endif LLSPSETUPONLY = .FALSE. ! Only create distributed spectral setup S%LDLL = .FALSE. ! use mapping to/from second set of latitudes @@ -341,6 +346,9 @@ SUBROUTINE SETUP_TRANS(KSMAX,KDGL,KDLON,KLOEN,LDSPLIT,PSTRET,& IF( LLSPSETUPONLY .OR. D%LGRIDONLY ) THEN TW%LFFTW = .FALSE. ENDIF +IF(PRESENT(LD_ALL_FFTW)) THEN + TW%LALL_FFTW=LD_ALL_FFTW +ENDIF #endif S%LSOUTHPNM=.FALSE. diff --git a/src/trans/include/ectrans/setup_trans.h b/src/trans/include/ectrans/setup_trans.h index 810e765b0..9548700fa 100644 --- a/src/trans/include/ectrans/setup_trans.h +++ b/src/trans/include/ectrans/setup_trans.h @@ -11,7 +11,7 @@ INTERFACE SUBROUTINE SETUP_TRANS(KSMAX,KDGL,KDLON,KLOEN,LDSPLIT,PSTRET,& &KTMAX,KRESOL,PWEIGHT,LDGRIDONLY,LDUSERPNM,LDKEEPRPNM,LDUSEFLT,& -&LDSPSETUPONLY,LDPNMONLY,LDUSEFFTW,& +&LDSPSETUPONLY,LDPNMONLY,LDUSEFFTW,LD_ALL_FFTW,& &LDLL,LDSHIFTLL,CDIO_LEGPOL,CDLEGPOLFNAME,KLEGPOLPTR,KLEGPOLPTR_LEN) !**** *SETUP_TRANS* - Setup transform package for specific resolution @@ -51,6 +51,7 @@ SUBROUTINE SETUP_TRANS(KSMAX,KDGL,KDLON,KLOEN,LDSPLIT,PSTRET,& ! FLT, otherwise always kept) ! LDPNMONLY - Compute the Legendre polynomialsonly, not the FFTs. ! LDUSEFFTW - Use FFTW for FFTs +! LD_ALL_FFTW : T to transform all fields in one call, F to transforms fields one after another ! LDLL - Setup second set of input/output latitudes ! the number of input/output latitudes to transform is equal KDGL ! or KDGL+2 in the case that includes poles + equator @@ -96,6 +97,7 @@ REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PWEIGHT(:) REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PSTRET LOGICAL ,OPTIONAL,INTENT(IN):: LDGRIDONLY LOGICAL ,OPTIONAL,INTENT(IN):: LDUSEFLT +LOGICAL ,OPTIONAL,INTENT(IN):: LD_ALL_FFTW LOGICAL ,OPTIONAL,INTENT(IN):: LDUSERPNM LOGICAL ,OPTIONAL,INTENT(IN):: LDKEEPRPNM LOGICAL ,OPTIONAL,INTENT(IN):: LDPNMONLY diff --git a/src/trans/internal/ftdir_mod.F90 b/src/trans/internal/ftdir_mod.F90 index f4be09e3f..2a61ddbd6 100644 --- a/src/trans/internal/ftdir_mod.F90 +++ b/src/trans/internal/ftdir_mod.F90 @@ -43,7 +43,7 @@ SUBROUTINE FTDIR(PREEL,KFIELDS,KGL) ! D. Degrauwe (Feb 2012): Alternative extension zone (E') ! G. Mozdzynski (Oct 2014): support for FFTW transforms ! G. Mozdzynski (Jun 2015): Support alternative FFTs to FFTW - +! R. El Khatib 08-Jun-2023 LALL_FFTW for better flexibility ! ------------------------------------------------------------------ USE PARKIND1 ,ONLY : JPIM, JPIB, JPRB @@ -65,7 +65,6 @@ SUBROUTINE FTDIR(PREEL,KFIELDS,KGL) INTEGER(KIND=JPIM) :: IGLG,IST,ILEN,IJUMP,JJ,JF,IST1 INTEGER(KIND=JPIM) :: IOFF,IRLEN,ICLEN, ITYPE -LOGICAL :: LL_ALL=.FALSE. ! T=do kfields ffts in one batch, F=do kfields ffts one at a time ! ------------------------------------------------------------------ @@ -103,7 +102,7 @@ SUBROUTINE FTDIR(PREEL,KFIELDS,KGL) #ifdef WITH_FFTW ELSE - CALL EXEC_FFTW(ITYPE,IRLEN,ICLEN,IOFF,KFIELDS,LL_ALL,PREEL) + CALL EXEC_FFTW(ITYPE,IRLEN,ICLEN,IOFF,KFIELDS,TW%LALL_FFTW,PREEL) ENDIF #endif diff --git a/src/trans/internal/ftdirad_mod.F90 b/src/trans/internal/ftdirad_mod.F90 index ac7d2a2fc..fa4852880 100644 --- a/src/trans/internal/ftdirad_mod.F90 +++ b/src/trans/internal/ftdirad_mod.F90 @@ -42,7 +42,7 @@ SUBROUTINE FTDIRAD(PREEL,KFIELDS,KGL) ! D. Degrauwe (Feb 2012): Alternative extension zone (E') ! G. Mozdzynski (Oct 2014): support for FFTW transforms ! G. Mozdzynski (Jun 2015): Support alternative FFTs to FFTW - +! R. El Khatib 08-Jun-2023 LALL_FFTW for better flexibility ! ------------------------------------------------------------------ USE PARKIND1 ,ONLY : JPIM, JPRB @@ -64,7 +64,6 @@ SUBROUTINE FTDIRAD(PREEL,KFIELDS,KGL) INTEGER(KIND=JPIM) :: IGLG,IST,ILEN,IJUMP,JJ,JF,ILOEN INTEGER(KIND=JPIM) :: IOFF,IRLEN,ICLEN,ITYPE REAL(KIND=JPRB) :: ZMUL -LOGICAL :: LL_ALL=.FALSE. ! T=do kfields ffts in one batch, F=do kfields ffts one at a time ! ------------------------------------------------------------------ ITYPE = 1 @@ -101,7 +100,7 @@ SUBROUTINE FTDIRAD(PREEL,KFIELDS,KGL) #ifdef WITH_FFTW ELSE - CALL EXEC_FFTW(ITYPE,IRLEN,ICLEN,IOFF,KFIELDS,LL_ALL,PREEL) + CALL EXEC_FFTW(ITYPE,IRLEN,ICLEN,IOFF,KFIELDS,TW%LALL_FFTW,PREEL) ENDIF #endif diff --git a/src/trans/internal/ftinv_mod.F90 b/src/trans/internal/ftinv_mod.F90 index d13fd0622..ad4b89f95 100644 --- a/src/trans/internal/ftinv_mod.F90 +++ b/src/trans/internal/ftinv_mod.F90 @@ -42,6 +42,7 @@ SUBROUTINE FTINV(PREEL,KFIELDS,KGL) ! D. Degrauwe (Feb 2012): Alternative extension zone (E') ! G. Mozdzynski (Oct 2014): support for FFTW transforms ! G. Mozdzynski (Jun 2015): Support alternative FFTs to FFTW +! R. El Khatib 08-Jun-2023 LALL_FFTW for better flexibility ! ------------------------------------------------------------------ USE PARKIND1 ,ONLY : JPIM, JPRB @@ -62,7 +63,6 @@ SUBROUTINE FTINV(PREEL,KFIELDS,KGL) INTEGER(KIND=JPIM) :: IGLG,IST,ILEN,IJUMP,JJ,JF,IST1 INTEGER(KIND=JPIM) :: IOFF,IRLEN,ICLEN, ITYPE -LOGICAL :: LL_ALL=.FALSE. ! T=do kfields ffts in one batch, F=do kfields ffts one at a time ! ------------------------------------------------------------------ @@ -103,7 +103,7 @@ SUBROUTINE FTINV(PREEL,KFIELDS,KGL) #ifdef WITH_FFTW ELSE - CALL EXEC_FFTW(ITYPE,IRLEN,ICLEN,IOFF,KFIELDS,LL_ALL,PREEL) + CALL EXEC_FFTW(ITYPE,IRLEN,ICLEN,IOFF,KFIELDS,TW%LALL_FFTW,PREEL) ENDIF #endif diff --git a/src/trans/internal/ftinvad_mod.F90 b/src/trans/internal/ftinvad_mod.F90 index 86ca0506e..ebd1dd21b 100644 --- a/src/trans/internal/ftinvad_mod.F90 +++ b/src/trans/internal/ftinvad_mod.F90 @@ -42,7 +42,7 @@ SUBROUTINE FTINVAD(PREEL,KFIELDS,KGL) ! D. Degrauwe (Feb 2012): Alternative extension zone (E') ! G. Mozdzynski (Oct 2014): support for FFTW transforms ! G. Mozdzynski (Jun 2015): Support alternative FFTs to FFTW - +! R. El Khatib 08-Jun-2023 LALL_FFTW for better flexibility ! ------------------------------------------------------------------ USE PARKIND1 ,ONLY : JPIM, JPIB, JPRB @@ -65,7 +65,6 @@ SUBROUTINE FTINVAD(PREEL,KFIELDS,KGL) INTEGER(KIND=JPIM) :: IGLG,IST,ILEN,IJUMP,JJ,JF,ILOEN INTEGER(KIND=JPIM) :: IOFF,IRLEN,ICLEN,ITYPE -LOGICAL :: LL_ALL=.FALSE. ! T=do kfields ffts in one batch, F=do kfields ffts one at a time ! ------------------------------------------------------------------ @@ -109,7 +108,7 @@ SUBROUTINE FTINVAD(PREEL,KFIELDS,KGL) #ifdef WITH_FFTW ELSE - CALL EXEC_FFTW(ITYPE,IRLEN,ICLEN,IOFF,KFIELDS,LL_ALL,PREEL) + CALL EXEC_FFTW(ITYPE,IRLEN,ICLEN,IOFF,KFIELDS,TW%LALL_FFTW,PREEL) ENDIF #endif diff --git a/src/trans/internal/tpm_fftw.F90 b/src/trans/internal/tpm_fftw.F90 index 6386688ae..c98220945 100644 --- a/src/trans/internal/tpm_fftw.F90 +++ b/src/trans/internal/tpm_fftw.F90 @@ -17,6 +17,7 @@ MODULE TPM_FFTW ! -------------- ! Original October 2014 ! R. El Khatib 01-Sep-2015 More subroutines for better modularity +! R. El Khatib 08-Jun-2023 LALL_FFTW for better flexibility USE, INTRINSIC :: ISO_C_BINDING @@ -46,6 +47,7 @@ MODULE TPM_FFTW INTEGER(KIND=JPIM) :: N_MAX=0 ! maximum number of latitudes INTEGER(KIND=JPIM) :: N_MAX_PLANS=4 ! maximum number of plans for each active latitude LOGICAL :: LFFTW=.FALSE. + LOGICAL :: LALL_FFTW=.FALSE. ! T=do kfields ffts in one batch, F=do kfields ffts one at a time END TYPE FFTW_TYPE @@ -422,8 +424,8 @@ SUBROUTINE EXEC_EFFTW(KTYPE,KRLEN,KCLEN,KOFF,KFIELDS,LD_ALL,PREEL) CALL SFFTW_EXECUTE_DFT_C2R(IPLAN_C2R,ZFFT,ZFFT) END IF IF (LHOOK) CALL DR_HOOK('FFTW_EXECUTE_DFT_C2R',1,ZHOOK_HANDLE2) - DO JJ=1,KRLEN - DO JF=1,KFIELDS + DO JF=1,KFIELDS + DO JJ=1,KRLEN PREEL(KOFF+JJ-1,JF)=ZFFT(JJ,JF) ENDDO ENDDO @@ -440,8 +442,8 @@ SUBROUTINE EXEC_EFFTW(KTYPE,KRLEN,KCLEN,KOFF,KFIELDS,LD_ALL,PREEL) CALL SFFTW_EXECUTE_DFT_R2C(IPLAN_C2R,ZFFT,ZFFT) END IF IF (LHOOK) CALL DR_HOOK('FFTW_EXECUTE_DFT_R2C',1,ZHOOK_HANDLE2) - DO JJ=1,KCLEN - DO JF=1,KFIELDS + DO JF=1,KFIELDS + DO JJ=1,KCLEN PREEL(KOFF+JJ-1,JF)=ZFFT(JJ,JF)/REAL(KRLEN,JPRB) ENDDO ENDDO From ae51a5c0cd41857016f6e64ab088f5cbb10cc287 Mon Sep 17 00:00:00 2001 From: MARY Alexandre Date: Mon, 8 Apr 2024 17:36:35 +0000 Subject: [PATCH 03/25] phase with CY49R1 --- src/trans/external/ini_spec_dist.F90 | 11 +++-- src/trans/include/ectrans/get_current.h | 2 +- src/trans/include/ectrans/ini_spec_dist.h | 9 +++- src/trans/internal/dist_grid_ctl_mod.F90 | 52 ++++++++++---------- src/trans/internal/sutrle_mod.F90 | 59 +++++++++++------------ src/trans/internal/suwavedi_mod.F90 | 3 ++ 6 files changed, 73 insertions(+), 63 deletions(-) diff --git a/src/trans/external/ini_spec_dist.F90 b/src/trans/external/ini_spec_dist.F90 index 8260a508d..cc8f2cab6 100644 --- a/src/trans/external/ini_spec_dist.F90 +++ b/src/trans/external/ini_spec_dist.F90 @@ -9,7 +9,7 @@ ! SUBROUTINE INI_SPEC_DIST(KSMAX,KTMAX,KPRTRW,KMYSETW,KASM0,KSPOLEGL,KPROCM,& - &KUMPP,KSPEC,KSPEC2,KSPEC2MX,KPOSSP,KMYMS) + &KUMPP,KSPEC,KSPEC2,KSPEC2MX,KPOSSP,KMYMS,KPTRMS,KALLMS) !**** *INI_SPEC_DIST* - Initialize spectral wave distribution @@ -37,6 +37,9 @@ SUBROUTINE INI_SPEC_DIST(KSMAX,KTMAX,KPRTRW,KMYSETW,KASM0,KSPOLEGL,KPROCM,& ! KSPEC2MX - Maximum KSPEC2 across PEs (output) ! KPOSSP - Global spectral fields partitioning (output) ! KMYMS - This PEs spectral zonal wavenumbers (output) +! KPTRMS - Pointer to the first wave number of a given a-set (output) +! KALLMS - Wave numbers for all wave-set concatenated together +! to give all wave numbers in wave-set order (output) ! Implicit arguments : NONE ! -------------------- @@ -70,8 +73,10 @@ SUBROUTINE INI_SPEC_DIST(KSMAX,KTMAX,KPRTRW,KMYSETW,KASM0,KSPOLEGL,KPROCM,& INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KASM0(0:KSMAX) INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KPROCM(0:KSMAX) INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KUMPP(KPRTRW) -INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KMYMS(KSMAX+1) INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KPOSSP(KPRTRW+1) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KMYMS(KSMAX+1) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KPTRMS(KPRTRW) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KALLMS(KSMAX+1) !ifndef INTERFACE REAL(KIND=JPHOOK) :: ZHOOK_HANDLE @@ -81,7 +86,7 @@ SUBROUTINE INI_SPEC_DIST(KSMAX,KTMAX,KPRTRW,KMYSETW,KASM0,KSPOLEGL,KPROCM,& IF (LHOOK) CALL DR_HOOK('INI_SPEC_DIST',0,ZHOOK_HANDLE) CALL SUWAVEDI(KSMAX,KTMAX,KPRTRW,KMYSETW,KASM0,KSPOLEGL,KPROCM,& - &KUMPP,KSPEC,KSPEC2,KSPEC2MX,KPOSSP,KMYMS) + &KUMPP,KSPEC,KSPEC2,KSPEC2MX,KPOSSP,KMYMS,KPTRMS,KALLMS) IF (LHOOK) CALL DR_HOOK('INI_SPEC_DIST',1,ZHOOK_HANDLE) diff --git a/src/trans/include/ectrans/get_current.h b/src/trans/include/ectrans/get_current.h index 882f9ee82..4ae86992e 100644 --- a/src/trans/include/ectrans/get_current.h +++ b/src/trans/include/ectrans/get_current.h @@ -1,4 +1,4 @@ -! (C) Copyright 2000- Meteo France. +! (C) Copyright 2000- ECMWF. ! (C) Copyright 2000- Meteo-France. ! This software is licensed under the terms of the Apache Licence Version 2.0 diff --git a/src/trans/include/ectrans/ini_spec_dist.h b/src/trans/include/ectrans/ini_spec_dist.h index 5b613950b..2abca9ff8 100644 --- a/src/trans/include/ectrans/ini_spec_dist.h +++ b/src/trans/include/ectrans/ini_spec_dist.h @@ -10,7 +10,7 @@ INTERFACE SUBROUTINE INI_SPEC_DIST(KSMAX,KTMAX,KPRTRW,KMYSETW,KASM0,KSPOLEGL,KPROCM,& - &KUMPP,KSPEC,KSPEC2,KSPEC2MX,KPOSSP,KMYMS) + &KUMPP,KSPEC,KSPEC2,KSPEC2MX,KPOSSP,KMYMS,KPTRMS,KALLMS) !**** *INI_SPEC_DIST* - Initialize spectral wave distribution @@ -38,6 +38,9 @@ SUBROUTINE INI_SPEC_DIST(KSMAX,KTMAX,KPRTRW,KMYSETW,KASM0,KSPOLEGL,KPROCM,& ! KSPEC2MX - Maximum KSPEC2 across PEs (output) ! KPOSSP - Global spectral fields partitioning (output) ! KMYMS - This PEs spectral zonal wavenumbers (output) +! KPTRMS - Pointer to the first wave number of a given a-set (output) +! KALLMS - Wave numbers for all wave-set concatenated together +! to give all wave numbers in wave-set order (output) ! Implicit arguments : NONE ! -------------------- @@ -66,7 +69,9 @@ INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KSPOLEGL INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KASM0(0:KSMAX) INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KPROCM(0:KSMAX) INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KUMPP(KPRTRW) -INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KMYMS(KSMAX+1) INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KPOSSP(KPRTRW+1) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KMYMS(KSMAX+1) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KPTRMS(KPRTRW) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KALLMS(KSMAX+1) END SUBROUTINE INI_SPEC_DIST END INTERFACE diff --git a/src/trans/internal/dist_grid_ctl_mod.F90 b/src/trans/internal/dist_grid_ctl_mod.F90 index 32207c2ee..349881d05 100644 --- a/src/trans/internal/dist_grid_ctl_mod.F90 +++ b/src/trans/internal/dist_grid_ctl_mod.F90 @@ -78,7 +78,7 @@ SUBROUTINE DIST_GRID_CTL(PGPG,KFDISTG,KPROMA,KFROM,PGP,KSORT) INTEGER(KIND=JPIM) :: JFLD,JB,JA,IGLOFF,IGL1,IGL2,IOFF,ILAST,ILOFF,ILENR INTEGER(KIND=JPIM) :: JGL,JLON,ISND,ITAG,J,IRCV INTEGER(KIND=JPIM) :: JKGLO,IEND,JROF,IBL,JROC -INTEGER(KIND=JPIM) :: ISENDREQ(NPROC,KFDISTG),ILEN(NPROC,KFDISTG) +INTEGER(KIND=JPIM) :: ISENDREQ(NPROC,KFDISTG),ILEN(NPROC,KFDISTG), IRECVREQ(KFDISTG) INTEGER(KIND=JPIM) :: IFROM,IMYFIELDS,IFLD INTEGER(KIND=JPIM), POINTER :: ISORT (:) LOGICAL :: LLSAME @@ -176,6 +176,24 @@ SUBROUTINE DIST_GRID_CTL(PGPG,KFDISTG,KPROMA,KFROM,PGP,KSORT) ! Message passing CALL GSTATS_BARRIER(791) CALL GSTATS(811,0) + ! Receive + + ALLOCATE(ZRCV(D%NGPTOTMX,KFDISTG)) + + IF( LLSAME )THEN + IRCV = KFROM(1) + ITAG = MTAGDISTGP + CALL MPL_RECV(ZRCV,KSOURCE=NPRCIDS(IRCV),KTAG=ITAG,& + &KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=IRECVREQ(1),CDSTRING='DIST_GRID_CTL:') + ELSE + DO JFLD=1,KFDISTG + IRCV = KFROM(JFLD) + ITAG = MTAGDISTGP+JFLD + CALL MPL_RECV(ZRCV(:,JFLD),KSOURCE=NPRCIDS(IRCV),KTAG=ITAG,& + &KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=IRECVREQ(JFLD),CDSTRING='DIST_GRID_CTL:') + ENDDO + ENDIF + ! Send IF( LLSAME )THEN IF(KFROM(1) == MYPROC) THEN @@ -200,44 +218,24 @@ SUBROUTINE DIST_GRID_CTL(PGPG,KFDISTG,KPROMA,KFROM,PGP,KSORT) ENDIF ENDDO ENDIF - - ! Receive - - ALLOCATE(ZRCV(D%NGPTOTMX,KFDISTG)) - - IF( LLSAME )THEN - IRCV = KFROM(1) - ITAG = MTAGDISTGP - CALL MPL_RECV(ZRCV,KSOURCE=NPRCIDS(IRCV),KTAG=ITAG,& - &KMP_TYPE=JP_BLOCKING_STANDARD,KOUNT=ILENR,CDSTRING='DIST_GRID_CTL:') - IF( ILENR /= D%NGPTOTMX*KFDISTG )THEN - CALL ABORT_TRANS(' DIST_GRID_CTL: INVALID RECEIVE MESSAGE LENGTH 1') - ENDIF - ELSE - DO JFLD=1,KFDISTG - IRCV = KFROM(JFLD) - ITAG = MTAGDISTGP+JFLD - CALL MPL_RECV(ZRCV(:,JFLD),KSOURCE=NPRCIDS(IRCV),KTAG=ITAG,& - &KMP_TYPE=JP_BLOCKING_STANDARD,KOUNT=ILENR,CDSTRING='DIST_GRID_CTL:') - IF( ILENR /= D%NGPTOT )THEN - CALL ABORT_TRANS(' DIST_GRID_CTL: INVALID RECEIVE MESSAGE LENGTH 2') - ENDIF - ENDDO - ENDIF -! Wait for send to complete +! Wait for sends and receives to complete IF( LLSAME )THEN IF(KFROM(1) == MYPROC) THEN CALL MPL_WAIT(KREQUEST=ISENDREQ(:,1), & & CDSTRING='DIST_GRID_CTL: WAIT 1') ENDIF + CALL MPL_WAIT(KREQUEST=IRECVREQ(1), & + & CDSTRING='DIST_GRID_CTL: WAIT 2') ELSE DO JFLD=1,KFDISTG IF(KFROM(JFLD) == MYPROC) THEN CALL MPL_WAIT(KREQUEST=ISENDREQ(:,JFLD), & - & CDSTRING='DIST_GRID_CTL: WAIT 2') + & CDSTRING='DIST_GRID_CTL: WAIT 3') ENDIF + CALL MPL_WAIT(KREQUEST=IRECVREQ(JFLD), & + & CDSTRING='DIST_GRID_CTL: WAIT 4') ENDDO ENDIF CALL GSTATS(811,1) diff --git a/src/trans/internal/sutrle_mod.F90 b/src/trans/internal/sutrle_mod.F90 index 96d083cb7..ece0e7aaf 100644 --- a/src/trans/internal/sutrle_mod.F90 +++ b/src/trans/internal/sutrle_mod.F90 @@ -128,6 +128,20 @@ SUBROUTINE SUTRLE(PNM,KGL,KLOOP) CALL GSTATS(1141,1) ENDIF +IRREQ=0 +DO JROC=1,NPRTRV-1 + IRECV = MYSETV+JROC + IF (IRECV > NPRTRV) IRECV = IRECV-NPRTRV + IRECVSET = IRECV + CALL SET2PE(IRECV,0,0,MYSETW,IRECVSET) + IRREQ = IRREQ+1 + CALL GSTATS(801,0) + CALL MPL_RECV(ZRCVBUFV(:,IRECVSET),KSOURCE=NPRCIDS(IRECV), & + &KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=IRECVREQ(IRREQ),& + & KTAG=ITAG,CDSTRING='SUTRLE:') + CALL GSTATS(801,1) +ENDDO + ISREQ = 0 DO JROC=1,NPRTRV-1 ISEND = MYSETV-JROC @@ -143,20 +157,6 @@ SUBROUTINE SUTRLE(PNM,KGL,KLOOP) ENDDO -IRREQ=0 -DO JROC=1,NPRTRV-1 - IRECV = MYSETV+JROC - IF (IRECV > NPRTRV) IRECV = IRECV-NPRTRV - IRECVSET = IRECV - CALL SET2PE(IRECV,0,0,MYSETW,IRECVSET) - IRREQ = IRREQ+1 - CALL GSTATS(801,0) - CALL MPL_RECV(ZRCVBUFV(:,IRECVSET),KSOURCE=NPRCIDS(IRECV), & - &KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=IRECVREQ(IRREQ),& - & KTAG=ITAG,CDSTRING='SUTRLE:') - CALL GSTATS(801,1) -ENDDO - IF(ISREQ > 0) THEN CALL GSTATS(801,0) CALL MPL_WAIT(KREQUEST=ISENDREQ(1:ISREQ), & @@ -276,22 +276,6 @@ SUBROUTINE SUTRLE(PNM,KGL,KLOOP) !$OMP END PARALLEL DO CALL GSTATS(1141,1) -ISREQ = 0 -DO JROC=1,NPRTRW-1 - ISEND = MYSETW-JROC - IF (ISEND <= 0) ISEND = ISEND+NPRTRW - ISENDSET = ISEND - CALL SET2PE(ISEND,0,0,ISENDSET,MYSETV) - ISENDSIZE = IPOSW(ISENDSET) - ISREQ = ISREQ+1 - CALL GSTATS(801,0) - CALL MPL_SEND(ZSNDBUFW(1:ISENDSIZE,ISENDSET),KDEST=NPRCIDS(ISEND), & - & KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=ISENDREQ(ISREQ),& - & KTAG=ITAG,CDSTRING='SUTRLE:') - CALL GSTATS(801,1) -ENDDO - - IRREQ = 0 DO JROC=1,NPRTRW-1 @@ -309,6 +293,21 @@ SUBROUTINE SUTRLE(PNM,KGL,KLOOP) CALL GSTATS(801,1) ENDDO +ISREQ = 0 +DO JROC=1,NPRTRW-1 + ISEND = MYSETW-JROC + IF (ISEND <= 0) ISEND = ISEND+NPRTRW + ISENDSET = ISEND + CALL SET2PE(ISEND,0,0,ISENDSET,MYSETV) + ISENDSIZE = IPOSW(ISENDSET) + ISREQ = ISREQ+1 + CALL GSTATS(801,0) + CALL MPL_SEND(ZSNDBUFW(1:ISENDSIZE,ISENDSET),KDEST=NPRCIDS(ISEND), & + & KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=ISENDREQ(ISREQ),& + & KTAG=ITAG,CDSTRING='SUTRLE:') + CALL GSTATS(801,1) +ENDDO + IF(ISREQ > 0) THEN CALL GSTATS(801,0) CALL MPL_WAIT(KREQUEST=ISENDREQ(1:ISREQ), & diff --git a/src/trans/internal/suwavedi_mod.F90 b/src/trans/internal/suwavedi_mod.F90 index 2e85b8af9..bad28d10b 100644 --- a/src/trans/internal/suwavedi_mod.F90 +++ b/src/trans/internal/suwavedi_mod.F90 @@ -39,6 +39,9 @@ SUBROUTINE SUWAVEDI(KSMAX,KTMAX,KPRTRW,KMYSETW,KASM0,KSPOLEGL,KPROCM,& ! KSPEC2MX - Maximum KSPEC2 across PEs (output) ! KPOSSP - Global spectral fields partitioning (output) ! KMYMS - This PEs spectral zonal wavenumbers (output) +! KPTRMS - Pointer to the first wave number of a given a-set (output) +! KALLMS - Wave numbers for all wave-set concatenated together +! to give all wave numbers in wave-set order (output) ! Implicit arguments : NONE ! -------------------- From 196070e7d9a732ba95b23a70bcae8733b70fecbf Mon Sep 17 00:00:00 2001 From: Daan Degrauwe Date: Thu, 30 May 2024 15:26:25 +0200 Subject: [PATCH 04/25] Added LAM transforms and LAM benchmark. --- CMakeLists.txt | 4 + src/CMakeLists.txt | 3 + src/etrans/CMakeLists.txt | 2 + src/etrans/biper/CMakeLists.txt | 44 + src/etrans/biper/external/etibihie.F90 | 101 ++ src/etrans/biper/external/fpbipere.F90 | 157 ++ src/etrans/biper/external/horiz_field.F90 | 66 + src/etrans/biper/include/etibihie.h | 22 + src/etrans/biper/include/fpbipere.h | 19 + src/etrans/biper/include/horiz_field.h | 13 + src/etrans/biper/internal/esmoothe_mod.F90 | 171 ++ src/etrans/biper/internal/espline_mod.F90 | 189 +++ src/etrans/biper/internal/ewindowe_mod.F90 | 162 ++ src/etrans/biper/internal/extper_mod.F90 | 144 ++ src/etrans/etrans/CMakeLists.txt | 54 + src/etrans/etrans/aux/ellips.F90 | 8 + src/etrans/etrans/aux/ellips.h | 91 + src/etrans/etrans/aux/ellips64.F90 | 8 + src/etrans/etrans/external/edir_trans.F90 | 500 ++++++ src/etrans/etrans/external/edir_transad.F90 | 493 ++++++ src/etrans/etrans/external/edist_grid.F90 | 136 ++ src/etrans/etrans/external/edist_spec.F90 | 195 +++ src/etrans/etrans/external/egath_grid.F90 | 129 ++ src/etrans/etrans/external/egath_spec.F90 | 203 +++ src/etrans/etrans/external/egpnorm_trans.F90 | 93 ++ src/etrans/etrans/external/einv_trans.F90 | 607 +++++++ src/etrans/etrans/external/einv_transad.F90 | 609 +++++++ src/etrans/etrans/external/esetup_trans.F90 | 308 ++++ src/etrans/etrans/external/especnorm.F90 | 136 ++ src/etrans/etrans/external/etrans_end.F90 | 147 ++ src/etrans/etrans/external/etrans_inq.F90 | 539 ++++++ src/etrans/etrans/external/etrans_release.F90 | 51 + src/etrans/etrans/include/edir_trans.h | 135 ++ src/etrans/etrans/include/edir_transad.h | 131 ++ src/etrans/etrans/include/edist_grid.h | 57 + src/etrans/etrans/include/edist_spec.h | 59 + src/etrans/etrans/include/egath_grid.h | 56 + src/etrans/etrans/include/egath_spec.h | 64 + src/etrans/etrans/include/egpnorm_trans.h | 59 + src/etrans/etrans/include/einv_trans.h | 151 ++ src/etrans/etrans/include/einv_transad.h | 150 ++ src/etrans/etrans/include/esetup_trans.h | 88 + src/etrans/etrans/include/especnorm.h | 56 + src/etrans/etrans/include/etrans_end.h | 41 + src/etrans/etrans/include/etrans_inq.h | 172 ++ src/etrans/etrans/include/etrans_release.h | 6 + src/etrans/etrans/internal/cpl_int_mod.F90 | 33 + src/etrans/etrans/internal/easre1ad_mod.F90 | 80 + src/etrans/etrans/internal/easre1b_mod.F90 | 93 ++ src/etrans/etrans/internal/easre1bad_mod.F90 | 97 ++ .../etrans/internal/edealloc_resol_mod.F90 | 102 ++ .../etrans/internal/edir_trans_ctl_mod.F90 | 202 +++ .../etrans/internal/edir_trans_ctlad_mod.F90 | 194 +++ .../internal/edist_spec_control_mod.F90 | 3 + src/etrans/etrans/internal/efsc_mod.F90 | 110 ++ src/etrans/etrans/internal/efscad_mod.F90 | 121 ++ src/etrans/etrans/internal/eftdir_ctl_mod.F90 | 214 +++ .../etrans/internal/eftdir_ctlad_mod.F90 | 201 +++ src/etrans/etrans/internal/eftdirad_mod.F90 | 119 ++ src/etrans/etrans/internal/eftinv_ctl_mod.F90 | 273 +++ .../etrans/internal/eftinv_ctlad_mod.F90 | 295 ++++ src/etrans/etrans/internal/eftinvad_mod.F90 | 128 ++ .../internal/egath_spec_control_mod.F90 | 201 +++ .../etrans/internal/einv_trans_ctl_mod.F90 | 298 ++++ .../etrans/internal/einv_trans_ctlad_mod.F90 | 292 ++++ src/etrans/etrans/internal/eledir_mod.F90 | 99 ++ src/etrans/etrans/internal/eledirad_mod.F90 | 118 ++ src/etrans/etrans/internal/eleinv_mod.F90 | 103 ++ src/etrans/etrans/internal/eleinvad_mod.F90 | 115 ++ src/etrans/etrans/internal/eltdir_ctl_mod.F90 | 117 ++ .../etrans/internal/eltdir_ctlad_mod.F90 | 109 ++ src/etrans/etrans/internal/eltdir_mod.F90 | 184 ++ src/etrans/etrans/internal/eltdirad_mod.F90 | 166 ++ src/etrans/etrans/internal/eltinv_ctl_mod.F90 | 129 ++ .../etrans/internal/eltinv_ctlad_mod.F90 | 116 ++ src/etrans/etrans/internal/eltinv_mod.F90 | 213 +++ src/etrans/etrans/internal/eltinvad_mod.F90 | 252 +++ src/etrans/etrans/internal/eprfi1_mod.F90 | 105 ++ src/etrans/etrans/internal/eprfi1ad_mod.F90 | 103 ++ src/etrans/etrans/internal/eprfi1b_mod.F90 | 110 ++ src/etrans/etrans/internal/eprfi1bad_mod.F90 | 110 ++ src/etrans/etrans/internal/eprfi2_mod.F90 | 85 + src/etrans/etrans/internal/eprfi2ad_mod.F90 | 82 + src/etrans/etrans/internal/eprfi2b_mod.F90 | 92 + src/etrans/etrans/internal/eprfi2bad_mod.F90 | 90 + src/etrans/etrans/internal/eset_resol_mod.F90 | 71 + .../etrans/internal/esetup_dims_mod.F90 | 46 + .../etrans/internal/esetup_geom_mod.F90 | 66 + .../etrans/internal/espnorm_ctl_mod.F90 | 64 + src/etrans/etrans/internal/espnormc_mod.F90 | 3 + src/etrans/etrans/internal/espnormd_mod.F90 | 55 + src/etrans/etrans/internal/espnsde_mod.F90 | 101 ++ src/etrans/etrans/internal/espnsdead_mod.F90 | 112 ++ src/etrans/etrans/internal/eupdsp_mod.F90 | 141 ++ src/etrans/etrans/internal/eupdspad_mod.F90 | 145 ++ src/etrans/etrans/internal/eupdspb_mod.F90 | 105 ++ src/etrans/etrans/internal/eupdspbad_mod.F90 | 133 ++ .../etrans/internal/euvtvd_comm_mod.F90 | 127 ++ src/etrans/etrans/internal/euvtvd_mod.F90 | 111 ++ src/etrans/etrans/internal/euvtvdad_mod.F90 | 128 ++ src/etrans/etrans/internal/evdtuv_mod.F90 | 125 ++ .../etrans/internal/evdtuvad_comm_mod.F90 | 163 ++ src/etrans/etrans/internal/evdtuvad_mod.F90 | 151 ++ src/etrans/etrans/internal/suefft_mod.F90 | 114 ++ .../etrans/internal/suemp_trans_mod.F90 | 267 +++ .../internal/suemp_trans_preleg_mod.F90 | 240 +++ src/etrans/etrans/internal/suemplat_mod.F90 | 252 +++ src/etrans/etrans/internal/suemplatb_mod.F90 | 236 +++ src/etrans/etrans/internal/suestaonl_mod.F90 | 451 +++++ src/etrans/etrans/internal/tpmald_dim.F90 | 23 + src/etrans/etrans/internal/tpmald_distr.F90 | 23 + src/etrans/etrans/internal/tpmald_fft.F90 | 20 + src/etrans/etrans/internal/tpmald_fields.F90 | 17 + src/etrans/etrans/internal/tpmald_geo.F90 | 22 + src/etrans/etrans/internal/tpmald_tcdis.F90 | 13 + src/programs/CMakeLists.txt | 9 + src/programs/ectrans-lam-benchmark.F90 | 1479 +++++++++++++++++ src/trans/CMakeLists.txt | 32 +- 118 files changed, 17227 insertions(+), 1 deletion(-) create mode 100644 src/etrans/CMakeLists.txt create mode 100644 src/etrans/biper/CMakeLists.txt create mode 100644 src/etrans/biper/external/etibihie.F90 create mode 100644 src/etrans/biper/external/fpbipere.F90 create mode 100644 src/etrans/biper/external/horiz_field.F90 create mode 100644 src/etrans/biper/include/etibihie.h create mode 100644 src/etrans/biper/include/fpbipere.h create mode 100644 src/etrans/biper/include/horiz_field.h create mode 100644 src/etrans/biper/internal/esmoothe_mod.F90 create mode 100644 src/etrans/biper/internal/espline_mod.F90 create mode 100644 src/etrans/biper/internal/ewindowe_mod.F90 create mode 100644 src/etrans/biper/internal/extper_mod.F90 create mode 100644 src/etrans/etrans/CMakeLists.txt create mode 100644 src/etrans/etrans/aux/ellips.F90 create mode 100644 src/etrans/etrans/aux/ellips.h create mode 100644 src/etrans/etrans/aux/ellips64.F90 create mode 100644 src/etrans/etrans/external/edir_trans.F90 create mode 100644 src/etrans/etrans/external/edir_transad.F90 create mode 100644 src/etrans/etrans/external/edist_grid.F90 create mode 100644 src/etrans/etrans/external/edist_spec.F90 create mode 100644 src/etrans/etrans/external/egath_grid.F90 create mode 100644 src/etrans/etrans/external/egath_spec.F90 create mode 100644 src/etrans/etrans/external/egpnorm_trans.F90 create mode 100644 src/etrans/etrans/external/einv_trans.F90 create mode 100644 src/etrans/etrans/external/einv_transad.F90 create mode 100644 src/etrans/etrans/external/esetup_trans.F90 create mode 100644 src/etrans/etrans/external/especnorm.F90 create mode 100644 src/etrans/etrans/external/etrans_end.F90 create mode 100644 src/etrans/etrans/external/etrans_inq.F90 create mode 100644 src/etrans/etrans/external/etrans_release.F90 create mode 100644 src/etrans/etrans/include/edir_trans.h create mode 100644 src/etrans/etrans/include/edir_transad.h create mode 100644 src/etrans/etrans/include/edist_grid.h create mode 100644 src/etrans/etrans/include/edist_spec.h create mode 100644 src/etrans/etrans/include/egath_grid.h create mode 100644 src/etrans/etrans/include/egath_spec.h create mode 100644 src/etrans/etrans/include/egpnorm_trans.h create mode 100644 src/etrans/etrans/include/einv_trans.h create mode 100644 src/etrans/etrans/include/einv_transad.h create mode 100644 src/etrans/etrans/include/esetup_trans.h create mode 100644 src/etrans/etrans/include/especnorm.h create mode 100644 src/etrans/etrans/include/etrans_end.h create mode 100644 src/etrans/etrans/include/etrans_inq.h create mode 100644 src/etrans/etrans/include/etrans_release.h create mode 100644 src/etrans/etrans/internal/cpl_int_mod.F90 create mode 100644 src/etrans/etrans/internal/easre1ad_mod.F90 create mode 100644 src/etrans/etrans/internal/easre1b_mod.F90 create mode 100644 src/etrans/etrans/internal/easre1bad_mod.F90 create mode 100644 src/etrans/etrans/internal/edealloc_resol_mod.F90 create mode 100644 src/etrans/etrans/internal/edir_trans_ctl_mod.F90 create mode 100644 src/etrans/etrans/internal/edir_trans_ctlad_mod.F90 create mode 100644 src/etrans/etrans/internal/edist_spec_control_mod.F90 create mode 100644 src/etrans/etrans/internal/efsc_mod.F90 create mode 100644 src/etrans/etrans/internal/efscad_mod.F90 create mode 100644 src/etrans/etrans/internal/eftdir_ctl_mod.F90 create mode 100644 src/etrans/etrans/internal/eftdir_ctlad_mod.F90 create mode 100644 src/etrans/etrans/internal/eftdirad_mod.F90 create mode 100644 src/etrans/etrans/internal/eftinv_ctl_mod.F90 create mode 100644 src/etrans/etrans/internal/eftinv_ctlad_mod.F90 create mode 100644 src/etrans/etrans/internal/eftinvad_mod.F90 create mode 100644 src/etrans/etrans/internal/egath_spec_control_mod.F90 create mode 100644 src/etrans/etrans/internal/einv_trans_ctl_mod.F90 create mode 100644 src/etrans/etrans/internal/einv_trans_ctlad_mod.F90 create mode 100644 src/etrans/etrans/internal/eledir_mod.F90 create mode 100644 src/etrans/etrans/internal/eledirad_mod.F90 create mode 100644 src/etrans/etrans/internal/eleinv_mod.F90 create mode 100644 src/etrans/etrans/internal/eleinvad_mod.F90 create mode 100644 src/etrans/etrans/internal/eltdir_ctl_mod.F90 create mode 100644 src/etrans/etrans/internal/eltdir_ctlad_mod.F90 create mode 100644 src/etrans/etrans/internal/eltdir_mod.F90 create mode 100644 src/etrans/etrans/internal/eltdirad_mod.F90 create mode 100644 src/etrans/etrans/internal/eltinv_ctl_mod.F90 create mode 100644 src/etrans/etrans/internal/eltinv_ctlad_mod.F90 create mode 100644 src/etrans/etrans/internal/eltinv_mod.F90 create mode 100644 src/etrans/etrans/internal/eltinvad_mod.F90 create mode 100644 src/etrans/etrans/internal/eprfi1_mod.F90 create mode 100644 src/etrans/etrans/internal/eprfi1ad_mod.F90 create mode 100644 src/etrans/etrans/internal/eprfi1b_mod.F90 create mode 100644 src/etrans/etrans/internal/eprfi1bad_mod.F90 create mode 100644 src/etrans/etrans/internal/eprfi2_mod.F90 create mode 100644 src/etrans/etrans/internal/eprfi2ad_mod.F90 create mode 100644 src/etrans/etrans/internal/eprfi2b_mod.F90 create mode 100644 src/etrans/etrans/internal/eprfi2bad_mod.F90 create mode 100644 src/etrans/etrans/internal/eset_resol_mod.F90 create mode 100644 src/etrans/etrans/internal/esetup_dims_mod.F90 create mode 100644 src/etrans/etrans/internal/esetup_geom_mod.F90 create mode 100644 src/etrans/etrans/internal/espnorm_ctl_mod.F90 create mode 100644 src/etrans/etrans/internal/espnormc_mod.F90 create mode 100644 src/etrans/etrans/internal/espnormd_mod.F90 create mode 100644 src/etrans/etrans/internal/espnsde_mod.F90 create mode 100644 src/etrans/etrans/internal/espnsdead_mod.F90 create mode 100644 src/etrans/etrans/internal/eupdsp_mod.F90 create mode 100644 src/etrans/etrans/internal/eupdspad_mod.F90 create mode 100644 src/etrans/etrans/internal/eupdspb_mod.F90 create mode 100644 src/etrans/etrans/internal/eupdspbad_mod.F90 create mode 100644 src/etrans/etrans/internal/euvtvd_comm_mod.F90 create mode 100644 src/etrans/etrans/internal/euvtvd_mod.F90 create mode 100644 src/etrans/etrans/internal/euvtvdad_mod.F90 create mode 100644 src/etrans/etrans/internal/evdtuv_mod.F90 create mode 100644 src/etrans/etrans/internal/evdtuvad_comm_mod.F90 create mode 100644 src/etrans/etrans/internal/evdtuvad_mod.F90 create mode 100644 src/etrans/etrans/internal/suefft_mod.F90 create mode 100644 src/etrans/etrans/internal/suemp_trans_mod.F90 create mode 100644 src/etrans/etrans/internal/suemp_trans_preleg_mod.F90 create mode 100644 src/etrans/etrans/internal/suemplat_mod.F90 create mode 100644 src/etrans/etrans/internal/suemplatb_mod.F90 create mode 100644 src/etrans/etrans/internal/suestaonl_mod.F90 create mode 100644 src/etrans/etrans/internal/tpmald_dim.F90 create mode 100644 src/etrans/etrans/internal/tpmald_distr.F90 create mode 100644 src/etrans/etrans/internal/tpmald_fft.F90 create mode 100644 src/etrans/etrans/internal/tpmald_fields.F90 create mode 100644 src/etrans/etrans/internal/tpmald_geo.F90 create mode 100644 src/etrans/etrans/internal/tpmald_tcdis.F90 create mode 100644 src/programs/ectrans-lam-benchmark.F90 diff --git a/CMakeLists.txt b/CMakeLists.txt index 89c513c3e..aec33e15b 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -60,6 +60,10 @@ ecbuild_add_option( FEATURE TRANSI DESCRIPTION "Compile TransI C-interface to trans" CONDITION HAVE_DOUBLE_PRECISION ) +ecbuild_add_option( FEATURE ETRANS + DEFAULT OFF + DESCRIPTION "Include Limited-Area-Model Transforms" ) + ectrans_find_lapack() ### Add sources and tests diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 7451aa03f..e6410ad64 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -11,3 +11,6 @@ add_subdirectory( programs ) if( HAVE_TRANSI ) add_subdirectory(transi) endif() +#if( HAVE_ETRANS ) +# add_subdirectory(etrans) +#endif() \ No newline at end of file diff --git a/src/etrans/CMakeLists.txt b/src/etrans/CMakeLists.txt new file mode 100644 index 000000000..7d8c39f0a --- /dev/null +++ b/src/etrans/CMakeLists.txt @@ -0,0 +1,2 @@ +add_subdirectory(biper) +add_subdirectory(etrans) \ No newline at end of file diff --git a/src/etrans/biper/CMakeLists.txt b/src/etrans/biper/CMakeLists.txt new file mode 100644 index 000000000..2159dc72e --- /dev/null +++ b/src/etrans/biper/CMakeLists.txt @@ -0,0 +1,44 @@ +## Assemble sources +ecbuild_list_add_pattern( LIST biper_src + GLOB + internal/* + external/* + QUIET + ) + +set( HAVE_dp ${HAVE_DOUBLE_PRECISION} ) +set( HAVE_sp ${HAVE_SINGLE_PRECISION} ) + +foreach( prec sp dp ) + if( HAVE_${prec} ) + + ecbuild_add_library( + TARGET biper_${prec} + LINKER_LANGUAGE Fortran + SOURCES ${biper_src} + #PUBLIC_INCLUDES #$ + #$ + #$ + #$ + PUBLIC_LIBS fiat parkind_${prec} + PRIVATE_LIBS trans_${prec} + ) + + #target_link_libraries( biper_${prec} PUBLIC fiat parkind_${prec} trans_${prec}) + + # not sure if modules should be installed: shouldn't biper be accessed through interface routines? + ectrans_target_fortran_module_directory( + TARGET biper_${prec} + MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/module/biper_${prec} + INSTALL_DIRECTORY module/biper_${prec} + ) + + endif() +endforeach() + +## Install biper interface +file( GLOB biper_interface include/biper/* ) +install( + FILES ${biper_interface} + DESTINATION include/ectrans +) diff --git a/src/etrans/biper/external/etibihie.F90 b/src/etrans/biper/external/etibihie.F90 new file mode 100644 index 000000000..033adf85d --- /dev/null +++ b/src/etrans/biper/external/etibihie.F90 @@ -0,0 +1,101 @@ +SUBROUTINE ETIBIHIE(KDLON,KDGL,KNUBI,KDLUX,KDGUX,& + & KSTART,KDLSM,PGPBI,LDBIX,LDBIY,KDADD) + +!**** tool ETIBIHIE : Doubly-periodicisation : isotropic spline +! ------------- method. + +! purpose : +! -------- +! KNUBI horizontal fields which are known on C U I, +! are extended over E, in order to obtain doubly-periodic +! fields. +! IF LDBIX is equal .TRUE. , then the fields are periodicise +! in the x ( or longitude ) direction. If it is not the case, +! KDLUX must be equal to KDLON. +! IF LDBIY is equal .TRUE. , then the fields are periodicise +! in the y ( or latitude ) direction. If it is not the case, +! KDGUX must be equal to KDGL. + +!* *CALL* *ETIBIHIE*(...) + +! externals : +! ---------- +! ESPLIN spline extension +! ESMOOTH smoothing across to get isotropy. + +! explicit arguments : +! ------------------ +! KDLON : upper bound for the x (or longitude) dimension +! of the gridpoint array on C U I U E +! KDGL : upper bound for the y (or latitude) dimension +! of the gridpoint array on C U I U E +! KNUBI : number of horizontal fields to doubly-periodicise. +! KDLUX : upper bound for the x (or longitude) dimension +! of C U I. +! KDGUX : upper bound for the y (or latitude) dimension +! of C U I. +! KSTART : first dimension in x direction of g-p array +! KDLSM : second dimension in x direction of g-p array +! PGPBI : gridpoint array on C U I U E. +! LDBIX : logical to periodicize or not +! in the x ( or longitude ) direction. +! LDBIY : logical to periodicize or not +! in the y ( or latitude ) direction. +! KDADD : 1 to test biperiodiz. + +! references : +! ---------- + +! author : +! ------ +! V. Ducrocq + +! modification : +! ------------ +! A. Stanesic 28/03/2008: KDADD - test of externalized biper. +! ------------------------------------------------------------------------- + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE ESPLINE_MOD +USE ESMOOTHE_MOD + +! ------------------------------------------------------------------------- + +IMPLICIT NONE + +INTEGER(KIND=JPIM),INTENT(IN) :: KNUBI +INTEGER(KIND=JPIM),INTENT(IN) :: KSTART +INTEGER(KIND=JPIM),INTENT(IN) :: KDLSM +INTEGER(KIND=JPIM),INTENT(IN) :: KDLON +INTEGER(KIND=JPIM),INTENT(IN) :: KDGL +INTEGER(KIND=JPIM),INTENT(IN) :: KDLUX +INTEGER(KIND=JPIM),INTENT(IN) :: KDGUX +INTEGER(KIND=JPIM),INTENT(IN) :: KDADD +REAL(KIND=JPRB),INTENT(INOUT) :: PGPBI(KSTART:KDLSM+KDADD,KNUBI,1:KDGL+KDADD) +LOGICAL,INTENT(IN) :: LDBIX +LOGICAL,INTENT(IN) :: LDBIY + +! ------------------------------------------------------------------------- + +REAL(KIND=JPRB) :: ZALFA +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------------- +IF (LHOOK) CALL DR_HOOK('ETIBIHIE',0,ZHOOK_HANDLE) +! ------------------------------------------------------------------------- + +!* 1. DOUBLY-PERIODICISE : +! ------------------ + +ZALFA = 0.0_JPRB + +CALL ESPLINE(1,KDLON,1,KDGL,KDLUX,KDGUX,KSTART,& + & KDLSM+KDADD,1,KDGL+KDADD,KNUBI,PGPBI,ZALFA,LDBIX,LDBIY,KDADD) +CALL ESMOOTHE(1,KDLON,1,KDGL,KDLUX,KDGUX,KSTART,& + & KDLSM+KDADD,1,KDGL+KDADD,KNUBI,PGPBI,LDBIX,LDBIY) + +! ------------------------------------------------------------------------- +IF (LHOOK) CALL DR_HOOK('ETIBIHIE',1,ZHOOK_HANDLE) +END SUBROUTINE ETIBIHIE diff --git a/src/etrans/biper/external/fpbipere.F90 b/src/etrans/biper/external/fpbipere.F90 new file mode 100644 index 000000000..6395ca9f4 --- /dev/null +++ b/src/etrans/biper/external/fpbipere.F90 @@ -0,0 +1,157 @@ +SUBROUTINE FPBIPERE(KDLUX,KDGUX,KDLON,KDGL,KNUBI,KD1,PGPBI,KDADD,LDZON, & + & LDBOYD, KDBOYD, PLBOYD) + +!**** *FPBIPERE* - Full-POS interface for double periodicisation + +! purpose : +! -------- +! To bi-periodicise the post-processed fields, or just fill the extension zone +! with the mean value of C+I area + +!** INTERFACE. +! ---------- +! *CALL* *FPBIPERE*(...) + +! EXPLICIT ARGUMENTS +! -------------------- +! KDLUX : upper bound for the x (or longitude) dimension of C U I. +! KDGUX : upper bound for the y (or latitude) dimension of C U I. +! KDLON : upper bound for the x (or longitude) dimension of the gridpoint array on C U I U E +! KDGL : upper bound for the y (or latitude) dimension of the gridpoint array on C U I U E +! KNUBI : number of horizontal fields to doubly-periodicise. +! KD1 : dimension of input/output array +! PGPBI : input/output gridpoint array on C U I U E. +! LDZON : .true. if input grid on C U I U E (.false. if C U I) +! KDADD : 1 to test biperiodiz. +! LDBOYD: perform boyd periodization (inside C U I) +! KDBOYD: array containing dimensions of boyd domain +! PLBOYD: scalar parameter for boyd (variable L in paper) + +! IMPLICIT ARGUMENTS +! -------------------- + +! METHOD. +! ------- +! SEE DOCUMENTATION + +! EXTERNALS. +! ---------- +! ESPLINE spline extension +! ESMOOTHE smoothing across to get isotropy. + +! REFERENCE. +! ---------- +! ECMWF Research Department documentation of the IFS + +! AUTHOR. +! ------- +! RYAD EL KHATIB *METEO-FRANCE* + +! MODIFICATIONS. +! -------------- +! R. El Khatib : 01-08-07 Pruning options +! M.Hamrud : 01-Oct-2003 CY28 Cleaning +! F. Taillefer : 04-10-21 Add LDZON +! A. Stanesic : 28-03-08: KDADD - test of externalized biper. +! D. Degrauwe : feb 2012 Boyd periodization +! R. El Khatib 27-Sep-2013 Boyd periodization in Fullpos-2 +! R. El Khatib 04-Aug-2016 new interface to ewindowe + cleaning +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK +USE ESPLINE_MOD +USE ESMOOTHE_MOD +USE EWINDOWE_MOD +! ------------------------------------------------------------------ + +IMPLICIT NONE + +INTEGER(KIND=JPIM),INTENT(IN) :: KNUBI +INTEGER(KIND=JPIM),INTENT(IN) :: KD1 +INTEGER(KIND=JPIM),INTENT(IN) :: KDLUX +INTEGER(KIND=JPIM),INTENT(IN) :: KDGUX +INTEGER(KIND=JPIM),INTENT(IN) :: KDLON +INTEGER(KIND=JPIM),INTENT(IN) :: KDGL +INTEGER(KIND=JPIM),INTENT(IN) :: KDADD +REAL(KIND=JPRB) ,INTENT(INOUT) :: PGPBI(KD1,KNUBI) +LOGICAL, OPTIONAL ,INTENT(IN) :: LDZON +LOGICAL ,INTENT(IN) ,OPTIONAL :: LDBOYD +INTEGER(KIND=JPIM),INTENT(IN) ,OPTIONAL :: KDBOYD(6) +REAL(KIND=JPRB) ,INTENT(IN) ,OPTIONAL :: PLBOYD + +! ------------------------------------------------------------------ + +REAL(KIND=JPRB), ALLOCATABLE :: ZGPBI(:,:,:) +INTEGER(KIND=JPIM) :: IND, ISTAE, JGL, JLON, JNUBI, ILONF, ILATF, IBWX, IBWY +INTEGER(KIND=JPIM) :: IBWXH, IBWYH, IND1 +INTEGER(KIND=JPIM) :: ILONI(KDLON), ILATI(KDGL) +INTEGER(KIND=JPIM) :: IDLUN, IDGUN, IDLUX, IDGUX +LOGICAL :: LLZON, LLBOYD +REAL(KIND=JPRB) :: ZALFA +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +#include "abor1.intfb.h" + +! ------------------------------------------------------------------ +IF (LHOOK) CALL DR_HOOK('FPBIPERE',0,ZHOOK_HANDLE) +! ------------------------------------------------------------------ + +LLBOYD=.FALSE. +IF (PRESENT(LDBOYD)) LLBOYD=LDBOYD + + +!* 2. DOUBLY-PERIODICISE +! ------------------ + +IF (LLBOYD) THEN + IF (.NOT.PRESENT(KDBOYD)) CALL ABOR1('FPBIPERE: Boyd periodization requires KDBOYD argument') + IF (.NOT.PRESENT(PLBOYD)) CALL ABOR1('FPBIPERE: Boyd periodization requires PLBOYD argument') + IBWX=KDBOYD(3) + IBWY=KDBOYD(6) + CALL EWINDOWE(KDLON,KDLUX,IBWX,KDGL,KDGUX,IBWY,KNUBI,PGPBI,PLBOYD,.TRUE.,.TRUE.) +ELSE + LLZON=.FALSE. + IF(PRESENT(LDZON)) LLZON=LDZON + ALLOCATE(ZGPBI(KDLON+KDADD,KNUBI,KDGL+KDADD)) + IF(LLZON) THEN +! Copy C+I+E + IND=KDLON + ELSE +! Copy C+I + IND=KDLUX + ENDIF +!$OMP PARALLEL DO SCHEDULE(STATIC,1) PRIVATE(JNUBI,ISTAE,JGL,JLON) + DO JNUBI=1,KNUBI + ISTAE=0 + DO JGL=1,KDGUX + DO JLON=1,KDLUX + ZGPBI(JLON,JNUBI,JGL)=PGPBI(ISTAE+JLON,JNUBI) + ENDDO + ISTAE=ISTAE+IND + ENDDO + ENDDO +!$OMP END PARALLEL DO + ZALFA = 0.0_JPRB + CALL ESPLINE(1,KDLON,1,KDGL,KDLUX,KDGUX,1,KDLON+KDADD,1,KDGL+KDADD,KNUBI,ZGPBI,& + & ZALFA,.TRUE.,.TRUE.,KDADD) + CALL ESMOOTHE(1,KDLON,1,KDGL,KDLUX,KDGUX,1,KDLON+KDADD,1,KDGL+KDADD,KNUBI,ZGPBI,& + & .TRUE.,.TRUE.) +!$OMP PARALLEL DO SCHEDULE(STATIC,1) PRIVATE(JNUBI,ISTAE,JGL,JLON) + DO JNUBI=1,KNUBI + ISTAE=0 + DO JGL=1,KDGL + DO JLON=1,KDLON + PGPBI(ISTAE+JLON,JNUBI)=ZGPBI(JLON,JNUBI,JGL) + ENDDO + ISTAE=ISTAE+KDLON + ENDDO + ENDDO +!$OMP END PARALLEL DO + DEALLOCATE(ZGPBI) +ENDIF + + +! ------------------------------------------------------------------ +IF (LHOOK) CALL DR_HOOK('FPBIPERE',1,ZHOOK_HANDLE) +END SUBROUTINE FPBIPERE diff --git a/src/etrans/biper/external/horiz_field.F90 b/src/etrans/biper/external/horiz_field.F90 new file mode 100644 index 000000000..0d66345c2 --- /dev/null +++ b/src/etrans/biper/external/horiz_field.F90 @@ -0,0 +1,66 @@ +SUBROUTINE HORIZ_FIELD(KX,KY,PHFIELD) + +! purpose : +! -------- +! To produce test horizontal field of temperature. + +! method : +! --------- +! Test horizontal input field is on horizontal grid size KXxKY points, and it +! represent's temperature. It is obtained form flollwing expression: +! PHFIELD(i,j)=280*(1+0.1*Sin[PPI*(i+0.5*IMAX)*(j+0.7*IMAX)/IMAX^2+1]) (Pierre Benard) + +! interface : +! --------- +! CALL HORIZ_FIELD(KX,KY,PHFIELD) + +! Explicit arguments : +! ------------------- +! KX - number of grid points in x +! KY - number of grid points in y +! PHFIELD - simulated 2D temperature horizontal field + +! externals : +! ---------- +! None. + +! references : +! ---------- + +! author : +! ------ +! 23-May-2008 Antonio Stanesic +! ---------------------------------------------------------------------- + +USE PARKIND1 , ONLY : JPIM ,JPRB +USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK + +! ---------------------------------------------------------------------- + +IMPLICIT NONE + +INTEGER(KIND=JPIM), INTENT(IN) :: KX +INTEGER(KIND=JPIM), INTENT(IN) :: KY +REAL(KIND=JPRB), INTENT(OUT) :: PHFIELD(KX,KY) + +! ---------------------------------------------------------------------- + +REAL(KIND=JPRB), PARAMETER :: PPI=3.141592 +INTEGER(KIND=JPIM) :: JX,JY,IMAX +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ---------------------------------------------------------------------- +IF (LHOOK) CALL DR_HOOK('HORIZ_FIELD',0,ZHOOK_HANDLE) +! ---------------------------------------------------------------------- + +IMAX=MAX(KX,KY) + +DO JY=1,KY + DO JX=1,KX + PHFIELD(JX,JY)=280*(1+0.1*SIN(PPI*(JX+0.5*IMAX)*(JY+0.7*IMAX)/(IMAX**2)+1)) + ENDDO +ENDDO + +! ---------------------------------------------------------------------- +IF (LHOOK) CALL DR_HOOK('HORIZ_FIELD',1,ZHOOK_HANDLE) +END SUBROUTINE HORIZ_FIELD diff --git a/src/etrans/biper/include/etibihie.h b/src/etrans/biper/include/etibihie.h new file mode 100644 index 000000000..53861fb33 --- /dev/null +++ b/src/etrans/biper/include/etibihie.h @@ -0,0 +1,22 @@ +INTERFACE +SUBROUTINE ETIBIHIE(KDLON,KDGL,KNUBI,KDLUX,KDGUX,& + & KSTART,KDLSM,PGPBI,LDBIX,LDBIY,KDADD) + +USE PARKIND1 ,ONLY : JPIM ,JPRB + +IMPLICIT NONE + +INTEGER(KIND=JPIM),INTENT(IN) :: KNUBI +INTEGER(KIND=JPIM),INTENT(IN) :: KSTART +INTEGER(KIND=JPIM),INTENT(IN) :: KDLSM +INTEGER(KIND=JPIM),INTENT(IN) :: KDLON +INTEGER(KIND=JPIM),INTENT(IN) :: KDGL +INTEGER(KIND=JPIM),INTENT(IN) :: KDLUX +INTEGER(KIND=JPIM),INTENT(IN) :: KDGUX +INTEGER(KIND=JPIM),INTENT(IN) :: KDADD +REAL(KIND=JPRB),INTENT(INOUT) :: PGPBI(KSTART:KDLSM+KDADD,KNUBI,1:KDGL+KDADD) +LOGICAL,INTENT(IN) :: LDBIX +LOGICAL,INTENT(IN) :: LDBIY + +END SUBROUTINE ETIBIHIE +END INTERFACE diff --git a/src/etrans/biper/include/fpbipere.h b/src/etrans/biper/include/fpbipere.h new file mode 100644 index 000000000..16fbc0cd4 --- /dev/null +++ b/src/etrans/biper/include/fpbipere.h @@ -0,0 +1,19 @@ +INTERFACE +SUBROUTINE FPBIPERE(KDLUX,KDGUX,KDLON,KDGL,KNUBI,KD1,PGPBI,KDADD,LDZON,& +& LDBOYD,KDBOYD,PLBOYD,PBIPOUT) +USE PARKIND1 ,ONLY : JPIM ,JPRB +INTEGER(KIND=JPIM),INTENT(IN) :: KNUBI +INTEGER(KIND=JPIM),INTENT(IN) :: KD1 +INTEGER(KIND=JPIM),INTENT(IN) :: KDLUX +INTEGER(KIND=JPIM),INTENT(IN) :: KDGUX +INTEGER(KIND=JPIM),INTENT(IN) :: KDLON +INTEGER(KIND=JPIM),INTENT(IN) :: KDGL +INTEGER(KIND=JPIM),INTENT(IN) :: KDADD +REAL(KIND=JPRB) ,INTENT(INOUT):: PGPBI(KD1,KNUBI) +LOGICAL, OPTIONAL ,INTENT(IN) :: LDZON +LOGICAL, OPTIONAL ,INTENT(IN) :: LDBOYD +INTEGER(KIND=JPIM), INTENT(IN), OPTIONAL :: KDBOYD(6) +REAL(KIND=JPRB) , INTENT(IN), OPTIONAL :: PLBOYD +REAL(KIND=JPRB) ,INTENT(OUT), OPTIONAL :: PBIPOUT(:,:) +END SUBROUTINE FPBIPERE +END INTERFACE diff --git a/src/etrans/biper/include/horiz_field.h b/src/etrans/biper/include/horiz_field.h new file mode 100644 index 000000000..6acb5d64b --- /dev/null +++ b/src/etrans/biper/include/horiz_field.h @@ -0,0 +1,13 @@ +INTERFACE +SUBROUTINE HORIZ_FIELD(KX,KY,PHFIELD) + +USE PARKIND1 ,ONLY : JPIM ,JPRB + +IMPLICIT NONE + +INTEGER(KIND=JPIM), INTENT(IN) :: KX +INTEGER(KIND=JPIM), INTENT(IN) :: KY +REAL(KIND=JPRB), INTENT(OUT) :: PHFIELD(KX,KY) +REAL(KIND=JPRB), PARAMETER :: PPI=3.141592 +END SUBROUTINE HORIZ_FIELD +END INTERFACE diff --git a/src/etrans/biper/internal/esmoothe_mod.F90 b/src/etrans/biper/internal/esmoothe_mod.F90 new file mode 100644 index 000000000..4d65fe998 --- /dev/null +++ b/src/etrans/biper/internal/esmoothe_mod.F90 @@ -0,0 +1,171 @@ +MODULE ESMOOTHE_MOD +CONTAINS +SUBROUTINE ESMOOTHE(KDLUN,KDLON,KDGUN,KDGL,KDLUX,KDGUX,KSTART,& + & KDLSM,KDGSA,KDGEN,KNUBI,PWORK,LDBIX,LDBIY) + +! purpose : +! -------- +! To smooth the fields over the extension zone. + +!* *CALL* *ESMOOTHE*(...) + +! externals : +! ---------- +! None + +! explicit arguments : +! ------------------ +! KDLUN : lower bound for the x (or longitude) dimension +! of the gridpoint array +! KDLON : upper bound for the x (or longitude) dimension +! of the gridpoint array on C U I U E +! KDGUN : lower bound for the y (or latitude) dimension +! of the gridpoint array +! KDGL : upper bound for the y (or latitude) dimension +! of the gridpoint array on C U I U E +! KDLUX : upper bound for the x (or longitude) dimension +! of C U I. +! KDGUX : upper bound for the y (or latitude) dimension +! of C U I. +! KDLSM : dimension in x direction of g-p array +! KDGSA : first dimension index in y of g-p array +! KDGEN : last dimension index in y of g-p array +! KSTART : first dimension index in x of g-p array +! KDLSM : last dimension index in x of g-p array +! KNUBI : number of levels to biperiodicise + +! PWORK : gridpoint array on C U I U E. + +! LDBIX : .TRUE.: biperiodicise in x direction (and vice versa) +! LDBIY : .TRUE.: biperiodicise in y direction (and vice versa) + +! references : +! ---------- + +! author : +! ------ +! Michal Batka and Radmila Bubnova ( B & B ) + +! modifications : +! ------------- +! R. El Khatib 03-05-05 Optimizations +! -------------------------------------------------------------- + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +! -------------------------------------------------------------- + +IMPLICIT NONE + +INTEGER(KIND=JPIM),INTENT(IN) :: KSTART +INTEGER(KIND=JPIM),INTENT(IN) :: KDLSM +INTEGER(KIND=JPIM),INTENT(IN) :: KDGSA +INTEGER(KIND=JPIM),INTENT(IN) :: KDGEN +INTEGER(KIND=JPIM),INTENT(IN) :: KNUBI +INTEGER(KIND=JPIM),INTENT(IN) :: KDLUN +INTEGER(KIND=JPIM),INTENT(IN) :: KDLON +INTEGER(KIND=JPIM),INTENT(IN) :: KDGUN +INTEGER(KIND=JPIM),INTENT(IN) :: KDGL +INTEGER(KIND=JPIM),INTENT(IN) :: KDLUX +INTEGER(KIND=JPIM),INTENT(IN) :: KDGUX +REAL(KIND=JPRB) ,INTENT(INOUT) :: PWORK(KSTART:KDLSM,KNUBI,KDGSA:KDGEN) +LOGICAL ,INTENT(IN) :: LDBIX +LOGICAL ,INTENT(IN) :: LDBIY + +! -------------------------------------------------------------- + +REAL(KIND=JPRB) :: ZPRAC(KDLUN-1:KDLON+1,KDGUN-1:KDGL+1) +INTEGER(KIND=JPIM) :: IEND, IENX1, IENX2, IENY1, IENY2, JFL, JLAT, JLL, JLON +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! -------------------------------------------------------------- +IF (LHOOK) CALL DR_HOOK('ESMOOTHE',0,ZHOOK_HANDLE) +! -------------------------------------------------------------- + +!* 1. Calculation. +! ------------ + +IEND = MAX(KDLON-KDLUX,KDGL-KDGUX) +IEND = (IEND+1)/2 +IENX1= KDLON +IENX2= KDGL +IENY1= KDGL +IENY2= KDLON +IF(LDBIX.AND.(.NOT.LDBIY)) THEN + IENX2 = KDGUX + IENY1 = KDGUX +ELSEIF((.NOT.LDBIX).AND.LDBIY) THEN + IENX1 = KDLUX + IENY2 = KDLUX +ELSEIF((.NOT.LDBIX).AND.(.NOT.LDBIY)) THEN + IF (LHOOK) CALL DR_HOOK('ESMOOTHE',1,ZHOOK_HANDLE) + RETURN +ENDIF + +DO JFL = 1, KNUBI + + DO JLL = 1, IEND + + DO JLON = KDLUX,KDLON + DO JLAT = KDGUN,KDGL + ZPRAC(JLON,JLAT) = PWORK(JLON,JFL,JLAT) + ENDDO + ENDDO + + DO JLON = KDLUX,KDLON + ZPRAC(JLON,KDGUN-1) = PWORK(JLON,JFL,KDGL) + ZPRAC(JLON,KDGL +1) = PWORK(JLON,JFL,KDGUN) + ENDDO + DO JLAT = KDGUN,KDGL + ZPRAC(KDLON+1,JLAT) = PWORK(KDLUN,JFL,JLAT) + ENDDO + ZPRAC(KDLON+1,KDGUN-1) = PWORK(KDLUN,JFL,KDGL) + ZPRAC(KDLON+1,KDGL +1) = PWORK(KDLUN,JFL,KDGUN) + + DO JLON = KDLUX + JLL,IENX1 - JLL + 1 + DO JLAT = KDGUN, IENX2 + PWORK(JLON,JFL,JLAT)=(4._JPRB*ZPRAC(JLON,JLAT)+2.0_JPRB*(ZPRAC(JLON+& + & 1,JLAT)+& + & ZPRAC(JLON-1,JLAT) + ZPRAC(JLON,JLAT+1) +& + & ZPRAC(JLON,JLAT-1)) + ZPRAC(JLON+1,JLAT+1) +& + & ZPRAC(JLON-1,JLAT+1) + ZPRAC(JLON+1,JLAT-1)+& + & ZPRAC(JLON-1,JLAT-1))/16._JPRB + ENDDO + ENDDO + + DO JLAT = KDGUX,KDGL + DO JLON = KDLUN,KDLON + ZPRAC(JLON,JLAT) = PWORK(JLON,JFL,JLAT) + ENDDO + ENDDO + + DO JLAT = KDGUX,KDGL + ZPRAC(KDLUN-1,JLAT) = PWORK(KDLON,JFL,JLAT) + ZPRAC(KDLON+1,JLAT) = PWORK(KDLUN,JFL,JLAT) + ENDDO + DO JLON = KDLUN,KDLON + ZPRAC(JLON,KDGL +1) = PWORK(JLON,JFL,KDGUN) + ENDDO + ZPRAC(KDLUN-1,KDGL +1) = PWORK(KDLON,JFL,KDGUN) + ZPRAC(KDLON+1,KDGL +1) = PWORK(KDLUN,JFL,KDGUN) + + DO JLAT = KDGUX + JLL, IENY1 - JLL + 1 + DO JLON = KDLUN,IENY2 + PWORK(JLON,JFL,JLAT)=(4._JPRB*ZPRAC(JLON,JLAT)+2.0_JPRB*(ZPRAC(JLON+& + & 1,JLAT)+& + & ZPRAC(JLON-1,JLAT) + ZPRAC(JLON,JLAT+1) +& + & ZPRAC(JLON,JLAT-1)) + ZPRAC(JLON+1,JLAT+1) +& + & ZPRAC(JLON-1,JLAT+1) + ZPRAC(JLON+1,JLAT-1)+& + & ZPRAC(JLON-1,JLAT-1))/16._JPRB + ENDDO + ENDDO + + ENDDO + +ENDDO + +! -------------------------------------------------------------- +IF (LHOOK) CALL DR_HOOK('ESMOOTHE',1,ZHOOK_HANDLE) +END SUBROUTINE ESMOOTHE +END MODULE ESMOOTHE_MOD diff --git a/src/etrans/biper/internal/espline_mod.F90 b/src/etrans/biper/internal/espline_mod.F90 new file mode 100644 index 000000000..e44880f19 --- /dev/null +++ b/src/etrans/biper/internal/espline_mod.F90 @@ -0,0 +1,189 @@ +MODULE ESPLINE_MOD +CONTAINS +SUBROUTINE ESPLINE(KDLUN,KDLON,KDGUN,KDGL,KDLUX,KDGUX,KSTART,& + & KDLSM,KDGSA,KDGEN,KNUBI,PWORK,PALFA,LDBIX,LDBIY,KDAD) + +! purpose : +! -------- +! Make spline extension. + +! *CALL* *ESPLINE*(...) + +! externals : +! ---------- +! None + +! explicit arguments : +! ------------------ +! KDLUN : lower bound for the x (or longitude) dimension +! of the gridpoint array +! KDLON : upper bound for the x (or longitude) dimension +! of the gridpoint array on C U I U E +! KDGUN : lower bound for the y (or latitude) dimension +! of the gridpoint array +! KDGL : upper bound for the y (or latitude) dimension +! of the gridpoint array on C U I U E +! KDLUX : upper bound for the x (or longitude) dimension +! of C U I. +! KDGUX : upper bound for the y (or latitude) dimension +! of C U I. +! KSTART : first dimension in x direction of g-p array +! KDLSM : last dimension in x direction of g-p array +! KDGSA : first dimension in y of g-p array +! KDGEN : last dimension in y of g-p array +! KNUBI : number of levels to biperiodicise +! PWORK : gridpoint array on C U I U E. +! PALFA : boundary condition of a spline: +! = 0. ... natural spline +! = 1. ... boundary condition computed differentially +! (additional option) +! LDBIX : .TRUE. biperiodicisation in x ( and vice versa ) +! LDBIY : .TRUE. biperiodicisation in y ( and vice versa ) +! KDAD : 1 for test of biperiodic. + +! references : +! ---------- + +! author : +! ------ +! Michal Batka and Radmila Bubnova ( B & B ) + +! modifications : +! ------------- +! J.Vivoda 03-2002 2D model fix +! A. Stanesic : 28-03-08: KDADD - test of externalized biper. +! ------------------------------------------------------------- + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +! ------------------------------------------------------------- + +IMPLICIT NONE + +INTEGER(KIND=JPIM),INTENT(IN) :: KSTART +INTEGER(KIND=JPIM),INTENT(IN) :: KDLSM +INTEGER(KIND=JPIM),INTENT(IN) :: KDGSA +INTEGER(KIND=JPIM),INTENT(IN) :: KDGEN +INTEGER(KIND=JPIM),INTENT(IN) :: KNUBI +INTEGER(KIND=JPIM),INTENT(IN) :: KDLUN +INTEGER(KIND=JPIM),INTENT(IN) :: KDLON +INTEGER(KIND=JPIM),INTENT(IN) :: KDGUN +INTEGER(KIND=JPIM),INTENT(IN) :: KDGL +INTEGER(KIND=JPIM),INTENT(IN) :: KDLUX +INTEGER(KIND=JPIM),INTENT(IN) :: KDGUX +REAL(KIND=JPRB) ,INTENT(INOUT) :: PWORK(KSTART:KDLSM,KNUBI,KDGSA:KDGEN) +REAL(KIND=JPRB) ,INTENT(IN) :: PALFA +LOGICAL ,INTENT(IN) :: LDBIX +LOGICAL ,INTENT(IN) :: LDBIY +INTEGER(KIND=JPIM),INTENT(IN) :: KDAD + +! ------------------------------------------------------------- + +LOGICAL :: LLBIX +LOGICAL :: LLBIY +INTEGER(KIND=JPIM) :: IENDX, IENDY, JFL, JLAT, JLON, IA +REAL(KIND=JPRB) :: ZA, ZB, ZC, ZD, ZEPSA, ZEPSB, ZJ, ZK, ZKP1,& + & ZLAM, ZLAMB, ZM1, ZM2, ZMM, ZNY +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------- +IF (LHOOK) CALL DR_HOOK('ESPLINE',0,ZHOOK_HANDLE) +! ------------------------------------------------------------- + +!* 1. Spline Extension. +! ------------------- + +LLBIX=LDBIX +LLBIY=LDBIY + +IF( KDLUN==1.AND.KDLUX==1 ) LLBIX=.FALSE. +IF( KDGUN==1.AND.KDGUX==1 ) LLBIY=.FALSE. + +IENDX = KDGUX +IENDY = KDLON + +IF(LLBIX.AND.(.NOT.LLBIY)) THEN + IENDY = KDLUN - 1 + +ELSEIF((.NOT.LLBIX).AND.LLBIY) THEN + IENDX = KDGUN - 1 + IENDY = KDLUX + +ELSEIF((.NOT.LLBIX).AND.(.NOT.LLBIY)) THEN + IF (LHOOK) CALL DR_HOOK('ESPLINE',1,ZHOOK_HANDLE) + RETURN +ENDIF +DO JFL = 1, KNUBI + + ZK = REAL(KDLON-KDLUX+1,JPRB) + ZKP1 = ZK + 1.0_JPRB + ZLAMB = ZK/ZKP1 + ZNY = PALFA/ZKP1 + + DO JLAT=KDGUN,IENDX + + ZEPSA = ((PWORK(KDLUN,JFL,JLAT)-PWORK(KDLUX,JFL,JLAT))/ZK -& + & PWORK(KDLUX,JFL,JLAT)+PWORK(KDLUX-1,JFL,JLAT))*6._JPRB/ZKP1 -& + & ZNY*(PWORK(KDLUX,JFL,JLAT)-2.0_JPRB* PWORK(KDLUX-1,JFL,JLAT)+& + & PWORK(KDLUX-2,JFL,JLAT)) + + ZEPSB = (PWORK(KDLUN+1,JFL,JLAT)-PWORK(KDLUN,JFL,JLAT) -& + & (PWORK(KDLUN,JFL,JLAT)-PWORK(KDLUX,JFL,JLAT))/ZK)*6._JPRB/ZKP1-& + & ZNY*(PWORK(KDLUN+2,JFL,JLAT)-2.0_JPRB* PWORK(KDLUN+1,JFL,JLAT)+& + & PWORK(KDLUN,JFL,JLAT)) + + ZMM = 4._JPRB - ZLAMB*ZLAMB + ZM1 = (2.0_JPRB*ZEPSA - ZLAMB*ZEPSB)/ZMM + ZM2 = (2.0_JPRB*ZEPSB - ZLAMB*ZEPSA)/ZMM + ZA = PWORK(KDLUX,JFL,JLAT) + ZB = (PWORK(KDLUN,JFL,JLAT)-PWORK(KDLUX,JFL,JLAT))/ZK-& + & (2.0_JPRB*ZM1 + ZM2) * ZK/6._JPRB + ZC = 0.5_JPRB * ZM1 + ZD = (ZM2 - ZM1)/(6._JPRB*ZK) + + DO JLON=KDLUX+1,KDLON+KDAD + ZJ = REAL(JLON - KDLUX,JPRB) + PWORK(JLON,JFL,JLAT) = ZA + ZJ * (ZB + ZJ * (ZC + ZD * ZJ)) + ENDDO + ENDDO + + ZK = REAL(KDGL - KDGUX + 1,JPRB) + ZKP1 = ZK + 1 + ZLAM = ZK/ZKP1 + ZNY = PALFA/ZKP1 + + DO JLON=KDLUN,IENDY+KDAD + + ZEPSA = ((PWORK(JLON,JFL,KDGUN)-PWORK(JLON,JFL,KDGUX))/ZK -& + & PWORK(JLON,JFL,KDGUX)+PWORK(JLON,JFL,KDGUX-1))*6._JPRB/ZKP1-& + & ZNY*(PWORK(JLON,JFL,KDGUX)-2.0_JPRB*PWORK(JLON,JFL,KDGUX-1)+& + & PWORK(JLON,JFL,KDGUX-2)) + + ZEPSB = (PWORK(JLON,JFL,KDGUN+1)-PWORK(JLON,JFL,KDGUN) -& + & (PWORK(JLON,JFL,KDGUN)-PWORK(JLON,JFL,KDGUX))/ZK)*6._JPRB/ZKP1-& + & ZNY*(PWORK(JLON,JFL,KDGUN+2)-2.0_JPRB*PWORK(JLON,JFL,KDGUN+1) +& + & PWORK(JLON,JFL,KDGUN)) + + ZMM = 4._JPRB - ZLAMB*ZLAMB + ZM1 = (2.0_JPRB*ZEPSA - ZLAMB*ZEPSB)/ ZMM + ZM2 = (2.0_JPRB*ZEPSB - ZLAMB*ZEPSA)/ ZMM + ZA = PWORK(JLON,JFL,KDGUX) + ZB = (PWORK(JLON,JFL,KDGUN)-PWORK(JLON,JFL,KDGUX))/ZK - (2.0_JPRB*& + & ZM1 & + & + ZM2) * ZK/6._JPRB + ZC = 0.5_JPRB * ZM1 + ZD = (ZM2 - ZM1)/(6._JPRB*ZK) + + DO JLAT=KDGUX+1,KDGL+KDAD + ZJ = REAL(JLAT - KDGUX,JPRB) + PWORK(JLON,JFL,JLAT) = ZA +ZJ*(ZB +ZJ*(ZC + ZJ * ZD)) + ENDDO + ENDDO + +ENDDO + +! ------------------------------------------------------------- +IF (LHOOK) CALL DR_HOOK('ESPLINE',1,ZHOOK_HANDLE) +END SUBROUTINE ESPLINE +END MODULE ESPLINE_MOD diff --git a/src/etrans/biper/internal/ewindowe_mod.F90 b/src/etrans/biper/internal/ewindowe_mod.F90 new file mode 100644 index 000000000..8d49a3379 --- /dev/null +++ b/src/etrans/biper/internal/ewindowe_mod.F90 @@ -0,0 +1,162 @@ +MODULE EWINDOWE_MOD + +CONTAINS + +SUBROUTINE EWINDOWE(KDLON,KDLUX,KBWX,KDGL,KDGUX,KBWY,KFLD,PGPIN,PSCAL,LDBIX,LDBIY) + +! purpose : +! -------- +! Make boyd periodic extension. + +! externals : +! ---------- +! None + +! explicit arguments : +! ------------------ +! KDLON : upper bound for the x (or longitude) dimension +! of C U I U P. +! KDGL : upper bound for the y (or latitude) dimension +! of the gridpoint array on C U I U P +! PGPIN : gridpoint array on C U I U P (gp:fields). +! PSCAL : window function scaling parameter +! LDBIX : .TRUE. windowing in x direction ( and vice versa ) +! LDBIY : .TRUE. windowing in y direction ( and vice versa ) + + +! references : +! ---------- + +! author : Fabrice Voitus and Piet Termonia, 07/2009 +! ------ +! +! modification : +! Daan Degrauwe 02/2012 Cleaned and generalized +! S. Martinez 03/2012 Calls to ERF under CPP key __PGI +! (ERF function is not intrinsic with PGI) +! R. El Khatib 27-Sep-2013 implicit sized PGPIN +! R. El Khatib 04-Aug-2016 new interface +! ----------------------------------------------- + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +IMPLICIT NONE + +INTEGER(KIND=JPIM),INTENT(IN) :: KDLON +INTEGER(KIND=JPIM),INTENT(IN) :: KDLUX +INTEGER(KIND=JPIM),INTENT(IN) :: KBWX +INTEGER(KIND=JPIM),INTENT(IN) :: KDGL +INTEGER(KIND=JPIM),INTENT(IN) :: KDGUX +INTEGER(KIND=JPIM),INTENT(IN) :: KBWY +INTEGER(KIND=JPIM),INTENT(IN) :: KFLD +REAL(KIND=JPRB) ,INTENT(INOUT) :: PGPIN((KDLUX+2*KBWX+2*(KDLON-KDLUX))*(KDGUX+2*KBWY+2*(KDGL-KDGUX)),KFLD) +REAL(KIND=JPRB) ,INTENT(IN) :: PSCAL +LOGICAL ,INTENT(IN) :: LDBIX +LOGICAL ,INTENT(IN) :: LDBIY + +! FERF function +! ------------- + +#ifdef __PGI +REAL(KIND=JPRB), EXTERNAL :: ERF +#endif + +! scalars +! -------- + +INTEGER(KIND=JPIM) :: JFL, JGL, JLON, IOFF, IDLW, IDGW +INTEGER(KIND=JPIM) :: IWX, ILWX, IRWX, IWY, ILWY, IRWY, IBWXO, IBWYO +INTEGER(KIND=JPIM) :: ILATF, ILONF, IND1, IND, IOFF_LEFT,IOFF_RIGHT,IOFF_BOTTOM,IOFF_TOP +REAL(KIND=JPRB) :: ZI, ZJ, ZK, ZL +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! local arrays : +! ------------ + +REAL(KIND=JPRB) :: ZBELX(2*KBWX+(KDLON-KDLUX)) +REAL(KIND=JPRB) :: ZBELY(2*KBWY+(KDGL -KDGUX)) + +!* 1. Boyd Bi-periodic Extension Method. +! --------------------------------- + +IF (LHOOK) CALL DR_HOOK('EWINDOWE',0,ZHOOK_HANDLE) + +IF ((.NOT.LDBIX).AND.(.NOT.LDBIY)) THEN + IF (LHOOK) CALL DR_HOOK('EWINDOWE',1,ZHOOK_HANDLE) + RETURN +ENDIF + +IDGW=SIZE(ZBELY) +IDLW=SIZE(ZBELX) + +! Bell window functions : +! --------------------- + +IF (LDBIX) THEN + DO JLON=1,IDLW + ! variable between -1 and 1 + ZJ=REAL(-IDLW-1+2*JLON,JPRB)/(IDLW+1) + ZL=ZJ/SQRT(1.0_JPRB-(ZJ*ZJ)) +#ifdef __PGI + ZBELX(JLON)=(1.0_JPRB+ERF(REAL(PSCAL*ZL)))/2.0_JPRB +#else + ZBELX(JLON)=(1.0_JPRB+ERF(PSCAL*ZL))/2.0_JPRB +#endif + ENDDO +ENDIF + +IF (LDBIY) THEN + DO JGL=1,IDGW + ! variable between -1 and 1 + ZJ=REAL(-IDGW-1+2*JGL,JPRB)/(IDGW+1) + ZL=ZJ/SQRT(1.0_JPRB-(ZJ*ZJ)) +#ifdef __PGI + ZBELY(JGL)=(1.0_JPRB+ERF(REAL(PSCAL*ZL)))/2.0_JPRB +#else + ZBELY(JGL)=(1.0_JPRB+ERF(PSCAL*ZL))/2.0_JPRB +#endif + ENDDO +ENDIF + + +! Windowing on P+G-zone : +! -------------------- + +IOFF=(KDLUX+2*(KBWX+KDGL-KDGUX)) +IBWXO=KBWX+(KDLON-KDLUX) +IBWYO=KBWY+(KDGL-KDGUX) + +!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JFL,JGL,JLON,ILONF,ILATF,IND1,IND,IOFF_LEFT,IOFF_RIGHT,IOFF_BOTTOM,IOFF_TOP) +DO JFL=1,KFLD + IF (LDBIX) THEN + ! X-direction + DO JGL=1,KDGL+IDGW + IOFF_LEFT=(JGL-1)*IOFF + IOFF_RIGHT=IOFF_LEFT+KDLON + DO JLON=1,IDLW + PGPIN(IOFF_RIGHT+JLON,JFL) = ZBELX(JLON)*PGPIN(IOFF_LEFT+JLON,JFL) +& + & (1.0_JPRB-ZBELX(JLON))*PGPIN(IOFF_RIGHT+JLON,JFL) + ENDDO + ENDDO + ENDIF + IF (LDBIY) THEN + ! Y-direction + DO JGL=1,IDGW + IOFF_BOTTOM=(JGL-1)*IOFF + IOFF_TOP=(KDGL+JGL-1)*IOFF +!DIR$ IVDEP + DO JLON=1,KDLON+IDLW + PGPIN(IOFF_TOP+JLON,JFL) = ZBELY(JGL)*PGPIN(IOFF_BOTTOM+JLON,JFL) +& + & (1.0_JPRB-ZBELY(JGL))*PGPIN(IOFF_TOP+JLON,JFL) + ENDDO + ENDDO + ENDIF +ENDDO +!$OMP END PARALLEL DO + +IF (LHOOK) CALL DR_HOOK('EWINDOWE',1,ZHOOK_HANDLE) + +END SUBROUTINE EWINDOWE + +END MODULE EWINDOWE_MOD diff --git a/src/etrans/biper/internal/extper_mod.F90 b/src/etrans/biper/internal/extper_mod.F90 new file mode 100644 index 000000000..8135d8048 --- /dev/null +++ b/src/etrans/biper/internal/extper_mod.F90 @@ -0,0 +1,144 @@ +MODULE EXTPER_MOD +CONTAINS +SUBROUTINE EXTPER(PWORK,KDIM,KPSTA,KPOINTS,KFLDS,KUNITS,& + & KPOINTERS,KALFA) + +! purpose : +! -------- +! Make spline extension. + +! *CALL* *EXTPER(PWORK,KDIM,KPSTA,KPOINTS,KFLDS,KUNITS,& +! & KPOINTERS,KALFA) + +! externals : +! ---------- +! None + +! explicit arguments : +! ------------------ +! PWORK : Input: values in C U I area +! : Output: input+(spline extension on the E area) +! KDIM : Dimension of the C U I U E unit of work (one row or one m) +! KPSTA : Position where the unit of work starts +! KPOINTS : Position where the unit of work ends +! KFLDS : number of 2D fields +! KUNITS : Number of units of work +! KPOINTERS : Array of pointers for the units of work +! KALFA : boundary condition of a spline: +! = 0 ... natural spline +! = 1 ... boundary condition computed differentially +! (additional option) +! references : +! ---------- + +! author : +! ------ +! M. Hortal 03-11-2009 +! ----------------------------------------------- + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_GEN +USE TPM_DISTR + +IMPLICIT NONE + +REAL(KIND=JPRB) ,INTENT(INOUT) :: PWORK(:,:) +INTEGER(KIND=JPIM),INTENT(IN) :: KDIM +INTEGER(KIND=JPIM),INTENT(IN) :: KPSTA +INTEGER(KIND=JPIM),INTENT(IN) :: KPOINTS +INTEGER(KIND=JPIM),INTENT(IN) :: KFLDS +INTEGER(KIND=JPIM),INTENT(IN) :: KUNITS +INTEGER(KIND=JPIM),INTENT(IN) :: KPOINTERS(:) +INTEGER(KIND=JPIM),INTENT(IN) :: KALFA + +! arrays : +! -------- +INTEGER(KIND=JPIM) :: IENDX, IENDY, JFL, JLAT, JLON, IA + +REAL(KIND=JPRB) :: ZA, ZB, ZC, ZD, ZEPSA, ZEPSB, ZJ, ZK, ZKP1,& + & ZLAM, ZLAMB, ZM1, ZM2, ZMM, ZNY +REAL(KIND=JPRB) :: ZMAX(KUNITS), ZMIN(KUNITS) +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +#include "abor1.intfb.h" + +! ------------------------------------------------------------------ + +IF (LHOOK) CALL DR_HOOK('EXTPER',0,ZHOOK_HANDLE) + +!* 0. Security +! -------- + +IF(UBOUND(PWORK,1) < KFLDS) THEN + CALL ABOR1(' EXTPER, PWORK first dimension too small') +ENDIF +IF(UBOUND(PWORK,2) < KDIM+2) THEN + WRITE(NOUT,*) ' UBOUND(PWORK,2)=',UBOUND(PWORK,2),' KDIM=',KDIM,' KUNITS=',& + &KUNITS + CALL ABOR1(' EXTPER, PWORK second dimension too small') +ENDIF +IF(UBOUND(KPOINTERS,1) < KUNITS) THEN + CALL ABOR1(' EXTPER, KPOINTERS too small') +ENDIF +IF(UBOUND(PWORK,2) < KPOINTERS(KUNITS)+KDIM) THEN + WRITE(NERR,*) ' EXTPER, KUNITS=',KUNITS,' KPOINTERS=',KPOINTERS(1:KUNITS),& + &' KDIM=',KDIM,' UBOUND(PWORK,2)=',UBOUND(PWORK,2) + CALL ABOR1(' EXTPER, value of KPOINTERS too large') +ENDIF + +!* 1. Spline Extension. +! ------------------- + +DO JFL = 1, KFLDS + + ZK = REAL(KDIM-KPOINTS+1,JPRB) + ZKP1 = ZK + 1.0_JPRB + ZLAMB = ZK/ZKP1 + ZNY = REAL(KALFA,JPRB)/ZKP1 + + DO JLAT=1,KUNITS + ZEPSA = & + &((PWORK(JFL,KPOINTERS(JLAT)+KPSTA)-& + & PWORK(JFL,KPOINTERS(JLAT)+KPOINTS))/ZK -& + & PWORK(JFL,KPOINTERS(JLAT)+KPOINTS)+& + & PWORK(JFL,KPOINTERS(JLAT)+KPOINTS-1))*6._JPRB/ZKP1 -& + & ZNY*(PWORK(JFL,KPOINTERS(JLAT)+KPOINTS)-& + & 2.0_JPRB* PWORK(JFL,KPOINTERS(JLAT)+KPOINTS-1)+& + & PWORK(JFL,KPOINTERS(JLAT)+KPOINTS-2)) + + ZEPSB = (PWORK(JFL,KPOINTERS(JLAT)+KPSTA+1)-& + & PWORK(JFL,KPOINTERS(JLAT)+KPSTA) -& + & (PWORK(JFL,KPOINTERS(JLAT)+KPSTA)-& + & PWORK(JFL,KPOINTERS(JLAT)+KPOINTS))/ZK)*6._JPRB/ZKP1-& + & ZNY*(PWORK(JFL,KPOINTERS(JLAT)+KPSTA+2)-& + & 2.0_JPRB* PWORK(JFL,KPOINTERS(JLAT)+KPSTA+1)+& + & PWORK(JFL,KPOINTERS(JLAT)+KPSTA)) + + ZMM = 4._JPRB - ZLAMB*ZLAMB + ZM1 = (2.0_JPRB*ZEPSA - ZLAMB*ZEPSB)/ZMM + ZM2 = (2.0_JPRB*ZEPSB - ZLAMB*ZEPSA)/ZMM + ZA = PWORK(JFL,KPOINTERS(JLAT)+KPOINTS) + ZB = (PWORK(JFL,KPOINTERS(JLAT)+KPSTA)-& + & PWORK(JFL,KPOINTERS(JLAT)+KPOINTS))/ZK-& + & (2.0_JPRB*ZM1 + ZM2) * ZK/6._JPRB + ZC = 0.5_JPRB * ZM1 + ZD = (ZM2 - ZM1)/(6._JPRB*ZK) + + + DO JLON=KPOINTERS(JLAT)+KPOINTS+1,KPOINTERS(JLAT)+KDIM + + ZJ = REAL(JLON - (KPOINTERS(JLAT)+KPOINTS),JPRB) + PWORK(JFL,JLON) = ZA + ZJ * (ZB + ZJ * (ZC + ZD * ZJ)) + ENDDO + ENDDO + + +ENDDO + +IF (LHOOK) CALL DR_HOOK('EXTPER',1,ZHOOK_HANDLE) +END SUBROUTINE EXTPER +END MODULE EXTPER_MOD diff --git a/src/etrans/etrans/CMakeLists.txt b/src/etrans/etrans/CMakeLists.txt new file mode 100644 index 000000000..a29547d27 --- /dev/null +++ b/src/etrans/etrans/CMakeLists.txt @@ -0,0 +1,54 @@ + +## Assemble sources + +ecbuild_list_add_pattern( LIST etrans_src + GLOB + internal/* + external/* + aux/*.F90 + QUIET + ) + +set( HAVE_dp ${HAVE_DOUBLE_PRECISION} ) +set( HAVE_sp ${HAVE_SINGLE_PRECISION} ) + +foreach( prec sp dp ) + if( HAVE_${prec} ) + + ecbuild_add_library( + TARGET etrans_${prec} + LINKER_LANGUAGE Fortran + SOURCES ${etrans_src} + PUBLIC_INCLUDES #$ + $ + $ + #$ + PUBLIC_LIBS fiat parkind_${prec} + PRIVATE_LIBS trans_${prec} biper_${prec} + ) + ectrans_target_fortran_module_directory( + TARGET etrans_${prec} + MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/module/etrans_${prec} + INSTALL_DIRECTORY module/etrans_${prec} + ) + #target_link_libraries( biper_${prec} PUBLIC fiat parkind_${prec} trans_${prec} biper_${prec}) + #if( HAVE_FFTW ) # already resolved from trans, I presume + # target_link_libraries( etrans_${prec} ${FFTW_LINK} ${FFTW_LIBRARIES} ) + # target_include_directories( etrans_${prec} PRIVATE ${FFTW_INCLUDE_DIRS} ) + # target_compile_definitions( etrans_${prec} PRIVATE WITH_FFTW ) + #endif() + #target_link_libraries( etrans_${prec} ${LAPACK_LINK} ${LAPACK_${prec}} ) # lapack isn't used by etrans + #if( HAVE_OMP ) # already resolved from trans, I presume + # target_link_libraries( etrans_${prec} PRIVATE OpenMP::OpenMP_Fortran ) + #endif() + + endif() +endforeach() + +## Install trans interface + +file( GLOB etrans_interface include/etrans/* ) +install( + FILES ${etrans_interface} + DESTINATION include/ectrans +) diff --git a/src/etrans/etrans/aux/ellips.F90 b/src/etrans/etrans/aux/ellips.F90 new file mode 100644 index 000000000..e3af47323 --- /dev/null +++ b/src/etrans/etrans/aux/ellips.F90 @@ -0,0 +1,8 @@ +! Oct-2012 P. Marguinaud 64b LFI + +#undef JLIK +#undef _ELLIPS_ +#define JLIK JPIM +#define _ELLIPS_ ELLIPS +#include "ellips.h" + diff --git a/src/etrans/etrans/aux/ellips.h b/src/etrans/etrans/aux/ellips.h new file mode 100644 index 000000000..1e82d565e --- /dev/null +++ b/src/etrans/etrans/aux/ellips.h @@ -0,0 +1,91 @@ +! Jan-2011 P. Marguinaud Interface to thread-safe FA +SUBROUTINE _ELLIPS_ (KSMAX,KMSMAX,KNTMP,KMTMP) +USE PARKIND1, ONLY : JPRB, JPRD, JPIM, JPIB +USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK +IMPLICIT NONE +! +! ***ELLIPS*** - General routine for computing elliptic truncation +! +! Purpose. +! -------- +! Computation of zonal and meridional limit wavenumbers within the ellipse +! Interface: +! ---------- +! *CALL* *ELLIPS * +! +! Explicit arguments : +! -------------------- +! +! Implicit arguments : +! -------------------- +! +! +! Method. +! ------- +! See documentation +! +! Externals. NONE. +! ---------- +! +! Reference. +! ---------- +! ARPEGE/ALADIN documentation +! +! Author. +! ------- +! G. Radnoti LACE 97/04/04 +! +! Modifications. +! +!------------------------------------------------------------- +! J.Vivoda, 99/05/19 treating NSMAX=0 and NMSMAX=0 +! O.Nuissier, 23/09/01 Change type of real (simple --> +! double precision) +! +! +INTEGER (KIND=JLIK) KSMAX, KMSMAX +INTEGER (KIND=JLIK) KNTMP(0:KMSMAX),KMTMP(0:KSMAX) +! +INTEGER (KIND=JLIK) JM, JN +! +REAL (KIND=JPRD) ZEPS, ZKN, ZKM, ZAUXIL +! +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE +IF (LHOOK) CALL DR_HOOK('ELLIPS',0,ZHOOK_HANDLE) +ZEPS=1.E-10 +ZAUXIL=0. +! +! 1. Computing meridional limit wavenumbers along zonal wavenumbers +! +DO JM=1,KMSMAX-1 +ZKN = REAL(KSMAX,JPRD)/REAL(KMSMAX,JPRD)* & +& SQRT(MAX(ZAUXIL,REAL(KMSMAX**2-JM**2,JPRD))) + KNTMP(JM)=INT(ZKN+ZEPS, JLIK) +ENDDO + +IF( KMSMAX.EQ.0 )THEN + KNTMP(0)=KSMAX +ELSE + KNTMP(0)=KSMAX + KNTMP(KMSMAX)=0 +ENDIF +! +! 2. Computing zonal limit wavenumbers along meridional wavenumbers +! +DO JN=1,KSMAX-1 +ZKM = REAL(KMSMAX,JPRD)/REAL(KSMAX,JPRD)* & + & SQRT(MAX(ZAUXIL,REAL(KSMAX**2-JN**2,JPRD))) + KMTMP(JN)=INT(ZKM+ZEPS, JLIK) +ENDDO + +IF( KSMAX.EQ.0 )THEN + KMTMP(0)=KMSMAX +ELSE + KMTMP(0)=KMSMAX + KMTMP(KSMAX)=0 +ENDIF +! +IF (LHOOK) CALL DR_HOOK('ELLIPS',1,ZHOOK_HANDLE) +END + + diff --git a/src/etrans/etrans/aux/ellips64.F90 b/src/etrans/etrans/aux/ellips64.F90 new file mode 100644 index 000000000..083938214 --- /dev/null +++ b/src/etrans/etrans/aux/ellips64.F90 @@ -0,0 +1,8 @@ +! Oct-2012 P. Marguinaud 64b LFI + +#undef JLIK +#undef _ELLIPS_ +#define JLIK JPIB +#define _ELLIPS_ ELLIPS64 +#include "ellips.h" + diff --git a/src/etrans/etrans/external/edir_trans.F90 b/src/etrans/etrans/external/edir_trans.F90 new file mode 100644 index 000000000..bfebffaf2 --- /dev/null +++ b/src/etrans/etrans/external/edir_trans.F90 @@ -0,0 +1,500 @@ +SUBROUTINE EDIR_TRANS(PSPVOR,PSPDIV,PSPSCALAR,PSPSC3A,PSPSC3B,PSPSC2,& + & KPROMA,KVSETUV,KVSETSC,KRESOL,KVSETSC3A,KVSETSC3B,KVSETSC2,& + & PGP,PGPUV,PGP3A,PGP3B,PGP2,PMEANU,PMEANV,AUX_PROC) + +!**** *EDIR_TRANS* - Direct spectral transform (from grid-point to spectral). + +! Purpose. +! -------- +! Interface routine for the direct spectral transform + +!** Interface. +! ---------- +! CALL EDIR_TRANS(...) + +! Explicit arguments : All arguments except from PGP are optional. +! -------------------- +! PSPVOR(:,:) - spectral vorticity (output) +! PSPDIV(:,:) - spectral divergence (output) +! PSPSCALAR(:,:) - spectral scalarvalued fields (output) +! PSPSC3A(:,:,:) - alternative to use of PSPSCALAR, see PGP3A below (input) +! PSPSC3B(:,:,:) - alternative to use of PSPSCALAR, see PGP3B below (input) +! PSPSC2(:,:) - alternative to use of PSPSCALAR, see PGP2 below (input) +! KPROMA - required blocking factor for gridpoint output +! KVSETUV(:) - indicating which 'b-set' in spectral space owns a +! vor/div field. Equivalant to NBSETLEV in the IFS. +! The length of KVSETUV should be the GLOBAL number +! of u/v fields which is the dimension of u and v releated +! fields in grid-point space. +! KVESETSC(:) - indicating which 'b-set' in spectral space owns a +! scalar field. As for KVSETUV this argument is required +! if the total number of processors is greater than +! the number of processors used for distribution in +! spectral wave space. +! KVSETSC3A(:) - as KVESETSC for PSPSC3A (distribution on first dimension) +! KVSETSC3B(:) - as KVESETSC for PSPSC3B (distribution on first dimension) +! KVSETSC2(:) - as KVESETSC for PSPSC2 (distribution on first dimension) +! KRESOL - resolution tag which is required ,default is the +! first defined resulution (input) +! PGP(:,:,:) - gridpoint fields (input) +! PGP need to dimensioned (NPROMA,IF_GP,NGPBLKS) where +! NPROMA is the blocking factor, IF_GP the total number +! of output fields and NGPBLKS the number of NPROMA blocks. +! The ordering of the output fields is as follows (all +! parts are optional depending on the input switches): + +! u : IF_UV_G fields (if psvor present) +! v : IF_UV_G fields (if psvor present) +! scalar fields : IF_SCALARS_G fields (if pspscalar present) + +! Here IF_UV_G is the GLOBAL number of u/v fields as given by the length +! of KVSETUV (or by PSPVOR if no split in spectral 'b-set' direction +! IF_SCALARS_G is the GLOBAL number of scalar fields as giben by the +! length of KVESETSC (or by number of fields in PSPSCALAR if no spectral +! 'b-set' split + +! As an alternative to using PGP you can also use a combination of the +! following arrays. The reason for introducing these alternative ways +! of calling DIR_TRANS is to avoid uneccessary copies where your data +! structures don't fit in to the 'PSPVOR,PSPDIV, PSPSCALAR, PGP' layout. +! The use of any of these precludes the use of PGP and vice versa. + +! PGPUV(:,:,:,:) - the 'u-v' related grid-point variables in the order +! described for PGP. The second dimension of PGPUV should +! be the same as the "global" first dimension of +! PSPVOR,PSPDIV (in the IFS this is the number of levels) +! PGPUV need to be dimensioned(NPROMA,ILEVS,IFLDS,NGPBLKS) +! IFLDS is the number of 'variables' (u,v) +! PGP3A(:,:,:,:) - grid-point array directly connected with PSPSC3A +! dimensioned(NPROMA,ILEVS,IFLDS,NGPBLKS) +! IFLDS is the number of 'variables' (the same as in +! PSPSC3A ) +! PGP3B(:,:,:,:) - grid-point array directly connected with PSPSC3B +! dimensioned(NPROMA,ILEVS,IFLDS,NGPBLKS) +! IFLDS is the number of 'variables' (the same as in +! PSPSC3B) +! PGP2(:,:,:) - grid-point array directly connected with PSPSC2 +! dimensioned(NPROMA,IFLDS,NGPBLKS) +! IFLDS is the number of 'variables' (the same as in +! PSPSC2 ) +! PMEANU(:),PMEANV(:) - mean wind +! AUX_PROC - optional external procedure for biperiodization of +! aux.fields + +! Method. +! ------- + +! Externals. ESET_RESOL - set resolution +! ---------- ELTDIR_CTL - control of Legendre transform +! EFTDIR_CTL - control of Fourier transform + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-03-03 +! G. Radnoti: 01-03-13 adaptation to aladin +! P. Smolikova 02-09-30 : AUX_PROC for d4 in NH +! Y. Seity and G. Radnoti : 03-09-29 : phasing for AL27 +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! A.Bogatchev 19-04-2013 Comparison of ubound(pspdiv,1) +! with ubound(pspvor,1) +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +!ifndef INTERFACE + +USE TPM_GEN ,ONLY : NERR, NOUT +USE TPM_TRANS ,ONLY : LDIVGP, LSCDERS, LUVDER, LVORGP, & + & NF_SC2, NF_SC3A, NF_SC3B, NGPBLKS, NPROMA +USE TPM_DISTR ,ONLY : D, NPRTRV, MYSETV + +USE ESET_RESOL_MOD ,ONLY : ESET_RESOL +USE EDIR_TRANS_CTL_MOD ,ONLY : EDIR_TRANS_CTL +USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS + +!endif INTERFACE + +IMPLICIT NONE + +! Declaration of arguments + +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PSPVOR(:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PSPDIV(:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PSPSCALAR(:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PSPSC3A(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PSPSC3B(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PSPSC2(:,:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KPROMA +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KVSETUV(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KVSETSC(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KRESOL +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KVSETSC3A(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KVSETSC3B(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KVSETSC2(:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PGP(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PGPUV(:,:,:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PGP3A(:,:,:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PGP3B(:,:,:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PGP2(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PMEANU(:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PMEANV(:) +EXTERNAL AUX_PROC +OPTIONAL AUX_PROC + +!ifndef INTERFACE + +! Local variables +INTEGER(KIND=JPIM) :: IUBOUND(4),J +INTEGER(KIND=JPIM) :: IF_UV,IF_UV_G,IF_SCALARS,IF_SCALARS_G,IF_FS,IF_GP +INTEGER(KIND=JPIM) :: IF_SC2_G,IF_SC3A_G,IF_SC3B_G +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +! Set current resolution +IF (LHOOK) CALL DR_HOOK('EDIR_TRANS',0,ZHOOK_HANDLE) +CALL GSTATS(1808,0) +CALL ESET_RESOL(KRESOL) + +! Set defaults + +IF_UV = 0 +IF_UV_G = 0 +IF_SCALARS = 0 +IF_SCALARS_G = 0 +NF_SC2 = 0 +NF_SC3A = 0 +NF_SC3B = 0 +IF_SC2_G = 0 +IF_SC3A_G = 0 +IF_SC3B_G = 0 +NPROMA = D%NGPTOT +! This is for use in TRGTOL which is shared with adjoint inverse transform +LSCDERS=.FALSE. +LVORGP=.FALSE. +LDIVGP=.FALSE. +LUVDER=.FALSE. + +! Decide requirements + +IF(PRESENT(KVSETUV)) THEN + IF_UV_G = UBOUND(KVSETUV,1) + DO J=1,IF_UV_G + IF(KVSETUV(J) > NPRTRV .OR. KVSETUV(J) < 1) THEN + WRITE(NERR,*) 'DIR_TRANS:KVSETUV(J) > NPRTRV ',J,KVSETUV(J),NPRTRV + CALL ABORT_TRANS('DIR_TRANS:KVSETUV TOO LONG OR CONTAINS VALUES OUTSIDE RANGE') + ENDIF + IF(KVSETUV(J) == MYSETV) THEN + IF_UV = IF_UV+1 + ENDIF + ENDDO +ELSEIF(PRESENT(PSPVOR)) THEN + IF_UV = UBOUND(PSPVOR,1) + IF_UV_G = IF_UV +ENDIF + +IF(PRESENT(KVSETSC)) THEN + IF_SCALARS_G = UBOUND(KVSETSC,1) + DO J=1,IF_SCALARS_G + IF(KVSETSC(J) > NPRTRV .OR. KVSETSC(J) < 1) THEN + WRITE(NERR,*) 'DIR_TRANS:KVSETSC(J) > NPRTRV ',J,KVSETSC(J),NPRTRV + CALL ABORT_TRANS('DIR_TRANS:KVSETSC TOO LONG OR CONTAINS VALUES OUTSIDE RANGE') + ENDIF + IF(KVSETSC(J) == MYSETV) THEN + IF_SCALARS = IF_SCALARS+1 + ENDIF + ENDDO +ELSEIF(PRESENT(PSPSCALAR)) THEN + IF_SCALARS = UBOUND(PSPSCALAR,1) + IF_SCALARS_G = IF_SCALARS +ENDIF + +IF(PRESENT(KVSETSC2)) THEN + IF(.NOT.PRESENT(PSPSC2)) THEN + CALL ABORT_TRANS('DIR_TRANS:KVSETSC2 BUT NOT PSPSC2') + ENDIF + IF_SC2_G = UBOUND(KVSETSC2,1) + IF_SCALARS_G = IF_SCALARS_G+IF_SC2_G + DO J=1,UBOUND(KVSETSC2,1) + IF(KVSETSC2(J) > NPRTRV .OR. KVSETSC2(J) < 1) THEN + WRITE(NERR,*) 'DIR_TRANS:KVSETSC2(J) > NPRTRV ',J,KVSETSC2(J),NPRTRV + CALL ABORT_TRANS('DIR_TRANS:KVSETSC2 TOO LONG OR CONTAINS VALUES OUTSIDE RANGE') + ENDIF + IF(KVSETSC2(J) == MYSETV) THEN + IF_SCALARS = IF_SCALARS+1 + NF_SC2 = NF_SC2+1 + ENDIF + ENDDO +ELSEIF(PRESENT(PSPSC2)) THEN + IF_SC2_G = UBOUND(PSPSC2,1) + NF_SC2 = UBOUND(PSPSC2,1) + IF_SCALARS = IF_SCALARS+NF_SC2 + IF_SCALARS_G = IF_SCALARS_G +IF_SC2_G +ENDIF + +IF(PRESENT(KVSETSC3A)) THEN + IF(.NOT.PRESENT(PSPSC3A)) THEN + CALL ABORT_TRANS('DIR_TRANS:KVSETSC3A BUT NOT PSPSC3A') + ENDIF + IF_SC3A_G = UBOUND(KVSETSC3A,1) + IF_SCALARS_G = IF_SCALARS_G+IF_SC3A_G*UBOUND(PSPSC3A,3) + DO J=1,UBOUND(KVSETSC3A,1) + IF(KVSETSC3A(J) > NPRTRV .OR. KVSETSC3A(J) < 1) THEN + WRITE(NERR,*) 'DIR_TRANS:KVSETSC3A(J) > NPRTRV ',J,KVSETSC3A(J),NPRTRV + CALL ABORT_TRANS('DIR_TRANS:KVSETSC3A TOO LONG OR CONTAINS VALUES OUTSIDE RANGE') + ENDIF + IF(KVSETSC3A(J) == MYSETV) THEN + IF_SCALARS = IF_SCALARS+UBOUND(PSPSC3A,3) + NF_SC3A = NF_SC3A+1 + ENDIF + ENDDO +ELSEIF(PRESENT(PSPSC3A)) THEN + IF_SCALARS = IF_SCALARS+UBOUND(PSPSC3A,1)*UBOUND(PSPSC3A,3) + IF_SC3A_G = UBOUND(PSPSC3A,1) + IF_SCALARS_G = IF_SCALARS_G +IF_SC3A_G*UBOUND(PSPSC3A,3) + NF_SC3A = UBOUND(PSPSC3A,1) +ENDIF + +IF(PRESENT(KVSETSC3B)) THEN + IF(.NOT.PRESENT(PSPSC3B)) THEN + CALL ABORT_TRANS('DIR_TRANS:KVSETSC3B BUT NOT PSPSC3B') + ENDIF + IF_SC3B_G = UBOUND(KVSETSC3B,1) + IF_SCALARS_G = IF_SCALARS_G+IF_SC3B_G*UBOUND(PSPSC3B,3) + DO J=1,UBOUND(KVSETSC3B,1) + IF(KVSETSC3B(J) > NPRTRV .OR. KVSETSC3B(J) < 1) THEN + WRITE(NERR,*) 'DIR_TRANS:KVSETSC3B(J) > NPRTRV ',J,KVSETSC3B(J),NPRTRV + CALL ABORT_TRANS('DIR_TRANS:KVSETSC3B TOO LONG OR CONTAINS VALUES OUTSIDE RANGE') + ENDIF + IF(KVSETSC3B(J) == MYSETV) THEN + IF_SCALARS = IF_SCALARS+UBOUND(PSPSC3B,3) + NF_SC3B = NF_SC3B+1 + ENDIF + ENDDO +ELSEIF(PRESENT(PSPSC3B)) THEN + IF_SCALARS = IF_SCALARS+UBOUND(PSPSC3B,1)*UBOUND(PSPSC3B,3) + IF_SC3B_G = UBOUND(PSPSC3B,1) + IF_SCALARS_G = IF_SCALARS_G +IF_SC3B_G*UBOUND(PSPSC3B,3) + NF_SC3B = UBOUND(PSPSC3B,1) +ENDIF + +IF(PRESENT(KPROMA)) THEN + NPROMA = KPROMA +ENDIF + +! Compute derived variables + +NGPBLKS = (D%NGPTOT-1)/NPROMA+1 + +IF_FS = 2*IF_UV + IF_SCALARS + +IF_GP = 2*IF_UV_G+IF_SCALARS_G + +! Consistency checks + +IF (IF_UV > 0) THEN + IF(.NOT. PRESENT(PSPVOR) ) THEN + CALL ABORT_TRANS('DIR_TRANS : IF_UV > 0 BUT PSPVOR MISSING') + ENDIF + IF(UBOUND(PSPVOR,1) < IF_UV) THEN + WRITE(NERR,*)'DIR_TRANS : UBOUND(PSPVOR,1) < IF_UV ',UBOUND(PSPVOR,1),IF_UV + CALL ABORT_TRANS('DIR_TRANS : PSPVOR TOO SHORT') + ENDIF + IF(.NOT. PRESENT(PSPDIV) ) THEN + CALL ABORT_TRANS('DIR_TRANS : PSPVOR PRESENT BUT PSPDIV MISSING') + ENDIF + IF(UBOUND(PSPDIV,1) /= UBOUND(PSPVOR,1)) THEN + WRITE(NERR,*)'DIR_TRANS : UBOUND(PSPDIV,1) < IF_UV ',UBOUND(PSPDIV,1),IF_UV + CALL ABORT_TRANS('DIR_TRANS : INCONSISTENT FIRST DIM. OF PSPVOR AND PSPDIV') + ENDIF +ENDIF + +IF (IF_SCALARS > 0) THEN + IF(PRESENT(PSPSCALAR)) THEN + IF(UBOUND(PSPSCALAR,1) < IF_SCALARS) THEN + WRITE(NERR,*)'DIR_TRANS : UBOUND(PSPSCALAR,1) < IF_SCALARS) ',& + & UBOUND(PSPSCALAR,1),IF_SCALARS + CALL ABORT_TRANS('DIR_TRANS : PSPSCALAR TOO SHORT') + ENDIF + IF(PRESENT(PSPSC3A))THEN + CALL ABORT_TRANS('DIR_TRANS : PSPSCALAR AND PSPSC3A BOTH PRESENT') + ENDIF + IF(PRESENT(PSPSC3B))THEN + CALL ABORT_TRANS('DIR_TRANS : PSPSCALAR AND PSPSC3B BOTH PRESENT') + ENDIF + IF(PRESENT(PSPSC2))THEN + CALL ABORT_TRANS('DIR_TRANS : PSPSCALAR AND PSPSC2 BOTH PRESENT') + ENDIF + ENDIF +ENDIF + +IF(NPRTRV >1) THEN + IF(IF_UV > 0 .AND. .NOT. PRESENT(KVSETUV)) THEN + WRITE(NERR,*)'NPRTRV >1 AND IF_UV > 0 AND NOT PRESENT(KVSETUV)',& + & NPRTRV,IF_UV + CALL ABORT_TRANS('DIR_TRANS: SPECIFY VERTICAL SPECTRAL DISTRIBUTION!') + ENDIF + IF(PRESENT(PSPSCALAR) .AND. .NOT. PRESENT(KVSETSC)) THEN + WRITE(NERR,*)'NPRTRV >1 AND PRESENT(PSPSCALAR) AND NOT PRESENT(KVSETSC)',& + & NPRTRV + CALL ABORT_TRANS('DIR_TRANS: SPECIFY VERTICAL SPECTRAL DISTRIBUTION!') + ENDIF + IF(PRESENT(PSPSC2) .AND. .NOT. PRESENT(KVSETSC2)) THEN + WRITE(NERR,*)'NPRTRV >1 AND PRESENT(PSPSC2) AND NOT PRESENT(KVSETSC2)',& + & NPRTRV + CALL ABORT_TRANS('DIR_TRANS: SPECIFY VERTICAL SPECTRAL DISTRIBUTION!') + ENDIF + IF(PRESENT(PSPSC3A) .AND. .NOT. PRESENT(KVSETSC3A)) THEN + WRITE(NERR,*)'NPRTRV >1 AND PRESENT(PSPSC3A) AND NOT PRESENT(KVSETSC3A)',& + & NPRTRV + CALL ABORT_TRANS('DIR_TRANS: SPECIFY VERTICAL SPECTRAL DISTRIBUTION!') + ENDIF + IF(PRESENT(PSPSC3B) .AND. .NOT. PRESENT(KVSETSC3B)) THEN + WRITE(NERR,*)'NPRTRV >1 AND PRESENT(PSPSC3B) AND NOT PRESENT(KVSETSC3B)',& + & NPRTRV + CALL ABORT_TRANS('DIR_TRANS: SPECIFY VERTICAL SPECTRAL DISTRIBUTION!') + ENDIF +ENDIF + +IF(PRESENT(PGP)) THEN + IUBOUND(1:3)=UBOUND(PGP) + IF(IUBOUND(1) < NPROMA) THEN + WRITE(NOUT,*)'DIR_TRANS:FIRST DIM. OF PGP TOO SMALL ',IUBOUND(1),NPROMA + CALL ABORT_TRANS('DIR_TRANS:FIRST DIMENSION OF PGP TOO SMALL ') + ENDIF + IF(IUBOUND(2) < IF_GP) THEN + WRITE(NOUT,*)'DIR_TRANS:SEC. DIM. OF PGP TOO SMALL ',IUBOUND(2),IF_GP + CALL ABORT_TRANS('DIR_TRANS:SECOND DIMENSION OF PGP TOO SMALL ') + ENDIF + IF(IUBOUND(3) < NGPBLKS) THEN + WRITE(NOUT,*)'DIR_TRANS:THIRD DIM. OF PGP TOO SMALL ',IUBOUND(3),NGPBLKS + CALL ABORT_TRANS('DIR_TRANS:THIRD DIMENSION OF PGP TOO SMALL ') + ENDIF +ENDIF + +IF(PRESENT(PGPUV)) THEN + IF(.NOT.PRESENT(PSPVOR)) THEN + CALL ABORT_TRANS('DIR_TRANS:PSPVOR HAS TO BE PRESENT WHEN PGPUV IS') + ENDIF + IUBOUND=UBOUND(PGPUV) + IF(IUBOUND(1) < NPROMA) THEN + WRITE(NOUT,*)'DIR_TRANS:FIRST DIM. OF PGPUV TOO SMALL ',IUBOUND(1),NPROMA + CALL ABORT_TRANS('DIR_TRANS:FIRST DIMENSION OF PGPUV TOO SMALL ') + ENDIF + IF(IUBOUND(2) /= IF_UV_G) THEN + WRITE(NOUT,*)'DIR_TRANS:SEC. DIM. OF PGPUV INCONSISTENT ',IUBOUND(2),IF_UV_G + CALL ABORT_TRANS('DIR_TRANS:SEC. DIMENSION OF PGPUV INCONSISTENT ') + ENDIF + IF(IUBOUND(3) < 2) THEN + WRITE(NOUT,*)'DIR_TRANS:THIRD DIM. OF PGPUV TOO SMALL ',IUBOUND(3),2 + CALL ABORT_TRANS('DIR_TRANS:THIRD DIMENSION OF PGPUV TOO SMALL ') + ENDIF + IF(IUBOUND(4) < NGPBLKS) THEN + WRITE(NOUT,*)'DIR_TRANS:FOURTH DIM. OF PGPUV TOO SMALL ',IUBOUND(4),NGPBLKS + CALL ABORT_TRANS('DIR_TRANS:FOURTH DIMENSION OF PGPUV TOO SMALL ') + ENDIF +ENDIF + +IF(PRESENT(PGP2)) THEN + IF(.NOT.PRESENT(PSPSC2)) THEN + CALL ABORT_TRANS('DIR_TRANS:PSPSC2 HAS TO BE PRESENT WHEN PGP2 IS') + ENDIF +ENDIF +IF(IF_SC2_G > 0) THEN + IF(PRESENT(PGP2)) THEN + IUBOUND(1:3)=UBOUND(PGP2) + IF(IUBOUND(1) < NPROMA) THEN + WRITE(NOUT,*)'DIR_TRANS:FIRST DIM. OF PGP2 TOO SMALL ',IUBOUND(1),NPROMA + CALL ABORT_TRANS('DIR_TRANS:FIRST DIMENSION OF PGP2 TOO SMALL ') + ENDIF + IF(IUBOUND(2) /= IF_SC2_G) THEN + WRITE(NOUT,*)'DIR_TRANS:SEC. DIM. OF PGP2 INCONSISTENT ',IUBOUND(2),IF_SC2_G + CALL ABORT_TRANS('DIR_TRANS:SEC. DIMENSION OF PGP2 INCONSISTENT') + ENDIF + IF(IUBOUND(3) < NGPBLKS) THEN + WRITE(NOUT,*)'DIR_TRANS:THIRD DIM. OF PGP2 TOO SMALL ',IUBOUND(3),NGPBLKS + CALL ABORT_TRANS('DIR_TRANS:THIRD DIMENSION OF PGP2 TOO SMALL ') + ENDIF + ELSE + CALL ABORT_TRANS('DIR_TRANS:PGP2 MISSING') + ENDIF +ENDIF + +IF(PRESENT(PGP3A)) THEN + IF(.NOT.PRESENT(PSPSC3A)) THEN + CALL ABORT_TRANS('DIR_TRANS:PSPSC3A HAS TO BE PRESENT WHEN PGP3A IS') + ENDIF +ENDIF +IF(IF_SC3A_G > 0) THEN + IF(PRESENT(PGP3A)) THEN + IUBOUND=UBOUND(PGP3A) + IF(IUBOUND(1) < NPROMA) THEN + WRITE(NOUT,*)'DIR_TRANS:FIRST DIM. OF PGP3A TOO SMALL ',IUBOUND(1),NPROMA + CALL ABORT_TRANS('DIR_TRANS:FIRST DIMENSION OF PGP3A TOO SMALL ') + ENDIF + IF(IUBOUND(2) /= IF_SC3A_G) THEN + WRITE(NOUT,*)'DIR_TRANS:SEC DIM. OF PGP3A INCONSISTENT ',IUBOUND(2),IF_SC3A_G + CALL ABORT_TRANS('DIR_TRANS:SEC. DIMENSION OF PGP3A INCONSISTENT ') + ENDIF + IF(IUBOUND(3) /= UBOUND(PSPSC3A,3) ) THEN + WRITE(NOUT,*)'DIR_TRANS:THIRD DIM. OF PGP3A INCONSISTENT ',& + & IUBOUND(3),UBOUND(PSPSC3A,3) + CALL ABORT_TRANS('DIR_TRANS:THIRD DIMENSION OF PGP3A INCONSISTENT ') + ENDIF + IF(IUBOUND(4) < NGPBLKS) THEN + WRITE(NOUT,*)'DIR_TRANS:FOURTH DIM. OF PGP3A TOO SMALL ',IUBOUND(4),NGPBLKS + CALL ABORT_TRANS('DIR_TRANS:FOURTH DIMENSION OF PGP3A TOO SMALL ') + ENDIF + ELSE + CALL ABORT_TRANS('DIR_TRANS:PGP3A MISSING') + ENDIF +ENDIF + +IF(PRESENT(PGP3B)) THEN + IF(.NOT.PRESENT(PSPSC3B)) THEN + CALL ABORT_TRANS('DIR_TRANS:PSPSC3B HAS TO BE PRESENT WHEN PGP3B IS') + ENDIF +ENDIF +IF(IF_SC3B_G > 0) THEN + IF(PRESENT(PGP3B)) THEN + IUBOUND=UBOUND(PGP3B) + IF(IUBOUND(1) < NPROMA) THEN + WRITE(NOUT,*)'DIR_TRANS:FIRST DIM. OF PGP3B TOO SMALL ',IUBOUND(1),NPROMA + CALL ABORT_TRANS('DIR_TRANS:FIRST DIMENSION OF PGP3B TOO SMALL ') + ENDIF + IF(IUBOUND(2) /= IF_SC3B_G) THEN + WRITE(NOUT,*)'DIR_TRANS:SEC DIM. OF PGP3B INCONSISTENT ',IUBOUND(2),IF_SC3B_G + CALL ABORT_TRANS('DIR_TRANS:SEC. DIMENSION OF PGP3B INCONSISTENT ') + ENDIF + IF(IUBOUND(3) /= UBOUND(PSPSC3B,3) ) THEN + WRITE(NOUT,*)'DIR_TRANS:THIRD DIM. OF PGP3B INCONSISTENT ',& + & IUBOUND(3),UBOUND(PSPSC3B,3) + CALL ABORT_TRANS('DIR_TRANS:THIRD DIMENSION OF PGP3B INCONSISTENT ') + ENDIF + IF(IUBOUND(4) < NGPBLKS) THEN + WRITE(NOUT,*)'DIR_TRANS:FOURTH DIM. OF PGP3B TOO SMALL ',IUBOUND(4),NGPBLKS + CALL ABORT_TRANS('DIR_TRANS:FOURTH DIMENSION OF PGP3B TOO SMALL ') + ENDIF + ELSE + CALL ABORT_TRANS('DIR_TRANS:PGP3B MISSING') + ENDIF +ENDIF +CALL GSTATS(1808,1) + +! ------------------------------------------------------------------ + +CALL EDIR_TRANS_CTL(IF_UV_G,IF_SCALARS_G,IF_GP,IF_FS,IF_UV,IF_SCALARS,& + & PSPVOR,PSPDIV,PSPSCALAR,KVSETUV,KVSETSC,PGP,& + & PSPSC3A,PSPSC3B,PSPSC2,KVSETSC3A,KVSETSC3B,KVSETSC2,PGPUV,PGP3A,PGP3B,PGP2,& + & PMEANU,PMEANV,AUX_PROC) +IF (LHOOK) CALL DR_HOOK('EDIR_TRANS',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ +!endif INTERFACE + +END SUBROUTINE EDIR_TRANS diff --git a/src/etrans/etrans/external/edir_transad.F90 b/src/etrans/etrans/external/edir_transad.F90 new file mode 100644 index 000000000..beac97c90 --- /dev/null +++ b/src/etrans/etrans/external/edir_transad.F90 @@ -0,0 +1,493 @@ +SUBROUTINE EDIR_TRANSAD(PSPVOR,PSPDIV,PSPSCALAR,PSPSC3A,PSPSC3B,PSPSC2,& + & KPROMA,KVSETUV,KVSETSC,KRESOL,KVSETSC3A,KVSETSC3B,KVSETSC2,& + & PGP,PGPUV,PGP3A,PGP3B,PGP2,PMEANU,PMEANV) + +!**** *EDIR_TRANSAD* - Direct spectral transform - adjoint. + +! Purpose. +! -------- +! Interface routine for the direct spectral transform - adjoint + +!** Interface. +! ---------- +! CALL EDIR_TRANSAD(...) + +! Explicit arguments : All arguments except from PGP are optional. +! -------------------- +! PSPVOR(:,:) - spectral vorticity (output) +! PSPDIV(:,:) - spectral divergence (output) +! PSPSCALAR(:,:) - spectral scalarvalued fields (output) +! PSPSC3A(:,:,:) - alternative to use of PSPSCALAR, see PGP3A below (input) +! PSPSC3B(:,:,:) - alternative to use of PSPSCALAR, see PGP3B below (input) +! PSPSC2(:,:) - alternative to use of PSPSCALAR, see PGP2 below (input) +! KPROMA - required blocking factor for gridpoint output +! KVSETUV(:) - indicating which 'b-set' in spectral space owns a +! vor/div field. Equivalant to NBSETLEV in the IFS. +! The length of KVSETUV should be the GLOBAL number +! of u/v fields which is the dimension of u and v releated +! fields in grid-point space. +! KVESETSC(:) - indicating which 'b-set' in spectral space owns a +! scalar field. As for KVSETUV this argument is required +! if the total number of processors is greater than +! the number of processors used for distribution in +! spectral wave space. +! KVSETSC3A(:) - as KVESETSC for PSPSC3A (distribution on first dimension) +! KVSETSC3B(:) - as KVESETSC for PSPSC3B (distribution on first dimension) +! KVSETSC2(:) - as KVESETSC for PSPSC2 (distribution on first dimension) +! KRESOL - resolution tag which is required ,default is the +! first defined resulution (input) +! PGP(:,:,:) - gridpoint fields (input) +! PGP need to dimensioned (NPROMA,IF_GP,NGPBLKS) where +! NPROMA is the blocking factor, IF_GP the total number +! of output fields and NGPBLKS the number of NPROMA blocks. +! The ordering of the output fields is as follows (all +! parts are optional depending on the input switches): + +! u : IF_UV_G fields (if psvor present) +! v : IF_UV_G fields (if psvor present) +! scalar fields : IF_SCALARS_G fields (if pspscalar present) + +! Here IF_UV_G is the GLOBAL number of u/v fields as given by the length +! of KVSETUV (or by PSPVOR if no split in spectral 'b-set' direction +! IF_SCALARS_G is the GLOBAL number of scalar fields as giben by the +! length of KVESETSC (or by number of fields in PSPSCALAR if no spectral +! 'b-set' split + +! As an alternative to using PGP you can also use a combination of the +! following arrays. The reason for introducing these alternative ways +! of calling DIR_TRANS is to avoid uneccessary copies where your data +! structures don't fit in to the 'PSPVOR,PSPDIV, PSPSCALAR, PGP' layout. +! The use of any of these precludes the use of PGP and vice versa. + +! PGPUV(:,:,:,:) - the 'u-v' related grid-point variables in the order +! described for PGP. The second dimension of PGPUV should +! be the same as the "global" first dimension of +! PSPVOR,PSPDIV (in the IFS this is the number of levels) +! PGPUV need to be dimensioned(NPROMA,ILEVS,IFLDS,NGPBLKS) +! IFLDS is the number of 'variables' (u,v) +! PGP3A(:,:,:,:) - grid-point array directly connected with PSPSC3A +! dimensioned(NPROMA,ILEVS,IFLDS,NGPBLKS) +! IFLDS is the number of 'variables' (the same as in +! PSPSC3A ) +! PGP3B(:,:,:,:) - grid-point array directly connected with PSPSC3B +! dimensioned(NPROMA,ILEVS,IFLDS,NGPBLKS) +! IFLDS is the number of 'variables' (the same as in +! PSPSC3B) +! PGP2(:,:,:) - grid-point array directly connected with PSPSC2 +! dimensioned(NPROMA,IFLDS,NGPBLKS) +! IFLDS is the number of 'variables' (the same as in +! PSPSC2 ) + +! Method. +! ------- + +! Externals. ESET_RESOL - set resolution +! ---------- EDIR_TRANS_CTLAD - control routine + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-03-03 +! M.Hamrud 01-Oct-2003 CY28 Cleaning + +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +!ifndef INTERFACE + +USE TPM_GEN ,ONLY : NERR, NOUT +USE TPM_TRANS ,ONLY : LDIVGP, LSCDERS, LUVDER, LVORGP, & + & NF_SC2, NF_SC3A, NF_SC3B, NGPBLKS, NPROMA +USE TPM_DISTR ,ONLY : D, NPRTRV, MYSETV + +USE ESET_RESOL_MOD ,ONLY : ESET_RESOL +USE EDIR_TRANS_CTLAD_MOD ,ONLY : EDIR_TRANS_CTLAD +USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS + +!endif INTERFACE + +IMPLICIT NONE + +! Declaration of arguments + +REAL(KIND=JPRB) ,OPTIONAL,INTENT(INOUT) :: PSPVOR(:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(INOUT) :: PSPDIV(:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(INOUT) :: PSPSCALAR(:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(INOUT) :: PSPSC3A(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(INOUT) :: PSPSC3B(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(INOUT) :: PSPSC2(:,:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KPROMA +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KVSETUV(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KVSETSC(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KRESOL +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KVSETSC3A(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KVSETSC3B(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KVSETSC2(:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PGP(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PGPUV(:,:,:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PGP3A(:,:,:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PGP3B(:,:,:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PGP2(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(INOUT) :: PMEANU(:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(INOUT) :: PMEANV(:) +!ifndef INTERFACE + +! Local variables +INTEGER(KIND=JPIM) :: IUBOUND(4),J +INTEGER(KIND=JPIM) :: IF_UV,IF_UV_G,IF_SCALARS,IF_SCALARS_G,IF_FS,IF_GP +INTEGER(KIND=JPIM) :: IF_SC2_G,IF_SC3A_G,IF_SC3B_G +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +IF (LHOOK) CALL DR_HOOK('EDIR_TRANSAD',0,ZHOOK_HANDLE) + +CALL GSTATS(1810,0) + +! Set current resolution +CALL ESET_RESOL(KRESOL) + +! Set defaults + +IF_UV = 0 +IF_UV_G = 0 +IF_SCALARS = 0 +IF_SCALARS_G = 0 +NF_SC2 = 0 +NF_SC3A = 0 +NF_SC3B = 0 +IF_SC2_G = 0 +IF_SC3A_G = 0 +IF_SC3B_G = 0 +NPROMA = D%NGPTOT +LSCDERS=.FALSE. ! This is for use in TRLTOG which is shared with inverse transform +LVORGP=.FALSE. +LDIVGP=.FALSE. +LUVDER=.FALSE. + +! Decide requirements + +IF(PRESENT(KVSETUV)) THEN + IF_UV_G = UBOUND(KVSETUV,1) + DO J=1,IF_UV_G + IF(KVSETUV(J) > NPRTRV) THEN + WRITE(NERR,*) 'DIR_TRANSAD:KVSETUV(J) > NPRTRV ',J,KVSETUV(J),NPRTRV + CALL ABORT_TRANS('DIR_TRANSAD:KVSETUV CONTAINS VALUES OUTSIDE RANGE') + ENDIF + IF(KVSETUV(J) == MYSETV) THEN + IF_UV = IF_UV+1 + ENDIF + ENDDO +ELSEIF(PRESENT(PSPVOR)) THEN + IF_UV = UBOUND(PSPVOR,1) + IF_UV_G = IF_UV +ENDIF + +IF(PRESENT(KVSETSC)) THEN + IF_SCALARS_G = UBOUND(KVSETSC,1) + DO J=1,IF_SCALARS_G + IF(KVSETSC(J) > NPRTRV) THEN + WRITE(NERR,*) 'DIR_TRANSAD:KVSETSC(J) > NPRTRV ',J,KVSETSC(J),NPRTRV + CALL ABORT_TRANS('DIR_TRANSAD:KVSETSC CONTAINS VALUES OUTSIDE RANGE') + ENDIF + IF(KVSETSC(J) == MYSETV) THEN + IF_SCALARS = IF_SCALARS+1 + ENDIF + ENDDO +ELSEIF(PRESENT(PSPSCALAR)) THEN + IF_SCALARS = UBOUND(PSPSCALAR,1) + IF_SCALARS_G = IF_SCALARS +ENDIF + +IF(PRESENT(KVSETSC2)) THEN + IF(.NOT.PRESENT(PSPSC2)) THEN + CALL ABORT_TRANS('DIR_TRANS:KVSETSC2 BUT NOT PSPSC2') + ENDIF + IF_SC2_G = UBOUND(KVSETSC2,1) + IF_SCALARS_G = IF_SCALARS_G+IF_SC2_G + DO J=1,UBOUND(KVSETSC2,1) + IF(KVSETSC2(J) > NPRTRV .OR. KVSETSC2(J) < 1) THEN + WRITE(NERR,*) 'DIR_TRANS:KVSETSC2(J) > NPRTRV ',J,KVSETSC2(J),NPRTRV + CALL ABORT_TRANS('DIR_TRANS:KVSETSC2 TOO LONG OR CONTAINS VALUES OUTSIDE RANGE') + ENDIF + IF(KVSETSC2(J) == MYSETV) THEN + IF_SCALARS = IF_SCALARS+1 + NF_SC2 = NF_SC2+1 + ENDIF + ENDDO +ELSEIF(PRESENT(PSPSC2)) THEN + IF_SC2_G = UBOUND(PSPSC2,1) + NF_SC2 = UBOUND(PSPSC2,1) + IF_SCALARS = IF_SCALARS+NF_SC2 + IF_SCALARS_G = IF_SCALARS_G +IF_SC2_G +ENDIF + +IF(PRESENT(KVSETSC3A)) THEN + IF(.NOT.PRESENT(PSPSC3A)) THEN + CALL ABORT_TRANS('DIR_TRANS:KVSETSC3A BUT NOT PSPSC3A') + ENDIF + IF_SC3A_G = UBOUND(KVSETSC3A,1) + IF_SCALARS_G = IF_SCALARS_G+IF_SC3A_G*UBOUND(PSPSC3A,3) + DO J=1,UBOUND(KVSETSC3A,1) + IF(KVSETSC3A(J) > NPRTRV .OR. KVSETSC3A(J) < 1) THEN + WRITE(NERR,*) 'DIR_TRANS:KVSETSC3A(J) > NPRTRV ',J,KVSETSC3A(J),NPRTRV + CALL ABORT_TRANS('DIR_TRANS:KVSETSC3A TOO LONG OR CONTAINS VALUES OUTSIDE RANGE') + ENDIF + IF(KVSETSC3A(J) == MYSETV) THEN + IF_SCALARS = IF_SCALARS+UBOUND(PSPSC3A,3) + NF_SC3A = NF_SC3A+1 + ENDIF + ENDDO +ELSEIF(PRESENT(PSPSC3A)) THEN + IF_SCALARS = IF_SCALARS+UBOUND(PSPSC3A,1)*UBOUND(PSPSC3A,3) + IF_SC3A_G = UBOUND(PSPSC3A,1) + IF_SCALARS_G = IF_SCALARS_G +IF_SC3A_G*UBOUND(PSPSC3A,3) + NF_SC3A = UBOUND(PSPSC3A,1) +ENDIF + +IF(PRESENT(KVSETSC3B)) THEN + IF(.NOT.PRESENT(PSPSC3B)) THEN + CALL ABORT_TRANS('DIR_TRANS:KVSETSC3B BUT NOT PSPSC3B') + ENDIF + IF_SC3B_G = UBOUND(KVSETSC3B,1) + IF_SCALARS_G = IF_SCALARS_G+IF_SC3B_G*UBOUND(PSPSC3B,3) + DO J=1,UBOUND(KVSETSC3B,1) + IF(KVSETSC3B(J) > NPRTRV .OR. KVSETSC3B(J) < 1) THEN + WRITE(NERR,*) 'DIR_TRANS:KVSETSC3B(J) > NPRTRV ',J,KVSETSC3B(J),NPRTRV + CALL ABORT_TRANS('DIR_TRANS:KVSETSC3B TOO LONG OR CONTAINS VALUES OUTSIDE RANGE') + ENDIF + IF(KVSETSC3B(J) == MYSETV) THEN + IF_SCALARS = IF_SCALARS+UBOUND(PSPSC3B,3) + NF_SC3B = NF_SC3B+1 + ENDIF + ENDDO +ELSEIF(PRESENT(PSPSC3B)) THEN + IF_SCALARS = IF_SCALARS+UBOUND(PSPSC3B,1)*UBOUND(PSPSC3B,3) + IF_SC3B_G = UBOUND(PSPSC3B,1) + IF_SCALARS_G = IF_SCALARS_G +IF_SC3B_G*UBOUND(PSPSC3B,3) + NF_SC3B = UBOUND(PSPSC3B,1) +ENDIF + +IF(PRESENT(KPROMA)) THEN + NPROMA = KPROMA +ENDIF + +! Compute derived variables + +NGPBLKS = (D%NGPTOT-1)/NPROMA+1 + +IF_FS = 2*IF_UV + IF_SCALARS + +IF_GP = 2*IF_UV_G+IF_SCALARS_G + +! Consistency checks + +IF (IF_UV > 0) THEN + IF(.NOT. PRESENT(PSPVOR) ) THEN + CALL ABORT_TRANS('DIR_TRANSAD : IF_UV > 0 BUT PSPVOR MISSING') + ENDIF + IF(UBOUND(PSPVOR,1) < IF_UV) THEN + WRITE(NERR,*)'DIR_TRANSAD : UBOUND(PSPVOR,1) < IF_UV ',& + & UBOUND(PSPVOR,1),IF_UV + CALL ABORT_TRANS('DIR_TRANSAD : PSPVOR TOO SHORT') + ENDIF + IF(.NOT. PRESENT(PSPDIV) ) THEN + CALL ABORT_TRANS('DIR_TRANSAD : PSPVOR PRESENT BUT PSPDIV MISSING') + ENDIF + IF(UBOUND(PSPDIV,1) /= IF_UV) THEN + WRITE(NERR,*)'DIR_TRANSAD : UBOUND(PSPDIV,1) < IF_UV ',& + & UBOUND(PSPDIV,1),IF_UV + CALL ABORT_TRANS('DIR_TRANSAD : INCONSISTENT FIRST DIM. OF PSPVOR AND PSPDIV') + ENDIF +ENDIF + +IF (IF_SCALARS > 0) THEN + IF(PRESENT(PSPSCALAR)) THEN + IF(UBOUND(PSPSCALAR,1) < IF_SCALARS) THEN + WRITE(NERR,*)'DIR_TRANS : UBOUND(PSPSCALAR,1) < IF_SCALARS) ',& + & UBOUND(PSPSCALAR,1),IF_SCALARS + CALL ABORT_TRANS('DIR_TRANS : PSPSCALAR TOO SHORT') + ENDIF + IF(PRESENT(PSPSC3A))THEN + CALL ABORT_TRANS('DIR_TRANS : PSPSCALAR AND PSPSC3A BOTH PRESENT') + ENDIF + IF(PRESENT(PSPSC3B))THEN + CALL ABORT_TRANS('DIR_TRANS : PSPSCALAR AND PSPSC3B BOTH PRESENT') + ENDIF + IF(PRESENT(PSPSC2))THEN + CALL ABORT_TRANS('DIR_TRANS : PSPSCALAR AND PSPSC2 BOTH PRESENT') + ENDIF + ENDIF +ENDIF + +IF(NPRTRV >1) THEN + IF(IF_UV > 0 .AND. .NOT. PRESENT(KVSETUV)) THEN + WRITE(NERR,*)'NPRTRV >1 AND IF_UV > 0 AND NOT PRESENT(KVSETUV)',& + & NPRTRV,IF_UV + CALL ABORT_TRANS('DIR_TRANS: SPECIFY VERTICAL SPECTRAL DISTRIBUTION!') + ENDIF + IF(PRESENT(PSPSCALAR) .AND. .NOT. PRESENT(KVSETSC)) THEN + WRITE(NERR,*)'NPRTRV >1 AND PRESENT(PSPSCALAR) AND NOT PRESENT(KVSETSC)',& + & NPRTRV + CALL ABORT_TRANS('DIR_TRANS: SPECIFY VERTICAL SPECTRAL DISTRIBUTION!') + ENDIF + IF(PRESENT(PSPSC2) .AND. .NOT. PRESENT(KVSETSC2)) THEN + WRITE(NERR,*)'NPRTRV >1 AND PRESENT(PSPSC2) AND NOT PRESENT(KVSETSC2)',& + & NPRTRV + CALL ABORT_TRANS('DIR_TRANS: SPECIFY VERTICAL SPECTRAL DISTRIBUTION!') + ENDIF + IF(PRESENT(PSPSC3A) .AND. .NOT. PRESENT(KVSETSC3A)) THEN + WRITE(NERR,*)'NPRTRV >1 AND PRESENT(PSPSC3A) AND NOT PRESENT(KVSETSC3A)',& + & NPRTRV + CALL ABORT_TRANS('DIR_TRANS: SPECIFY VERTICAL SPECTRAL DISTRIBUTION!') + ENDIF + IF(PRESENT(PSPSC3B) .AND. .NOT. PRESENT(KVSETSC3B)) THEN + WRITE(NERR,*)'NPRTRV >1 AND PRESENT(PSPSC3B) AND NOT PRESENT(KVSETSC3B)',& + & NPRTRV + CALL ABORT_TRANS('DIR_TRANS: SPECIFY VERTICAL SPECTRAL DISTRIBUTION!') + ENDIF +ENDIF + +IF(PRESENT(PGP)) THEN + IUBOUND(1:3)=UBOUND(PGP) + IF(IUBOUND(1) < NPROMA) THEN + WRITE(NOUT,*)'DIR_TRANS:FIRST DIM. OF PGP TOO SMALL ',IUBOUND(1),NPROMA + CALL ABORT_TRANS('DIR_TRANS:FIRST DIMENSION OF PGP TOO SMALL ') + ENDIF + IF(IUBOUND(2) < IF_GP) THEN + WRITE(NOUT,*)'DIR_TRANS:SEC. DIM. OF PGP TOO SMALL ',IUBOUND(2),IF_GP + CALL ABORT_TRANS('DIR_TRANS:SECOND DIMENSION OF PGP TOO SMALL ') + ENDIF + IF(IUBOUND(3) < NGPBLKS) THEN + WRITE(NOUT,*)'DIR_TRANS:THIRD DIM. OF PGP TOO SMALL ',IUBOUND(3),NGPBLKS + CALL ABORT_TRANS('DIR_TRANS:THIRD DIMENSION OF PGP TOO SMALL ') + ENDIF +ENDIF + +IF(PRESENT(PGPUV)) THEN + IF(.NOT.PRESENT(PSPVOR)) THEN + CALL ABORT_TRANS('DIR_TRANS:PSPVOR HAS TO BE PRESENT WHEN PGPUV IS') + ENDIF + IUBOUND=UBOUND(PGPUV) + IF(IUBOUND(1) < NPROMA) THEN + WRITE(NOUT,*)'DIR_TRANS:FIRST DIM. OF PGPUV TOO SMALL ',IUBOUND(1),NPROMA + CALL ABORT_TRANS('DIR_TRANS:FIRST DIMENSION OF PGPUV TOO SMALL ') + ENDIF + IF(IUBOUND(2) /= IF_UV_G) THEN + WRITE(NOUT,*)'DIR_TRANS:SEC. DIM. OF PGPUV INCONSISTENT ',IUBOUND(2),IF_UV_G + CALL ABORT_TRANS('DIR_TRANS:SEC. DIMENSION OF PGPUV INCONSISTENT ') + ENDIF + IF(IUBOUND(3) < 2) THEN + WRITE(NOUT,*)'DIR_TRANS:THIRD DIM. OF PGPUV TOO SMALL ',IUBOUND(3),2 + CALL ABORT_TRANS('DIR_TRANS:THIRD DIMENSION OF PGPUV TOO SMALL ') + ENDIF + IF(IUBOUND(4) < NGPBLKS) THEN + WRITE(NOUT,*)'DIR_TRANS:FOURTH DIM. OF PGPUV TOO SMALL ',IUBOUND(4),NGPBLKS + CALL ABORT_TRANS('DIR_TRANS:FOURTH DIMENSION OF PGPUV TOO SMALL ') + ENDIF +ENDIF + +IF(PRESENT(PGP2)) THEN + IF(.NOT.PRESENT(PSPSC2)) THEN + CALL ABORT_TRANS('DIR_TRANS:PSPSC2 HAS TO BE PRESENT WHEN PGP2 IS') + ENDIF +ENDIF +IF(IF_SC2_G > 0) THEN + IF(PRESENT(PGP2)) THEN + IUBOUND(1:3)=UBOUND(PGP2) + IF(IUBOUND(1) < NPROMA) THEN + WRITE(NOUT,*)'DIR_TRANS:FIRST DIM. OF PGP2 TOO SMALL ',IUBOUND(1),NPROMA + CALL ABORT_TRANS('DIR_TRANS:FIRST DIMENSION OF PGP2 TOO SMALL ') + ENDIF + IF(IUBOUND(2) /= IF_SC2_G) THEN + WRITE(NOUT,*)'DIR_TRANS:SEC. DIM. OF PGP2 INCONSISTENT ',IUBOUND(2),IF_SC2_G + CALL ABORT_TRANS('DIR_TRANS:SEC. DIMENSION OF PGP2 INCONSISTENT') + ENDIF + IF(IUBOUND(3) < NGPBLKS) THEN + WRITE(NOUT,*)'DIR_TRANS:THIRD DIM. OF PGP2 TOO SMALL ',IUBOUND(3),NGPBLKS + CALL ABORT_TRANS('DIR_TRANS:THIRD DIMENSION OF PGP2 TOO SMALL ') + ENDIF + ELSE + CALL ABORT_TRANS('DIR_TRANS:PGP2 MISSING') + ENDIF +ENDIF + +IF(PRESENT(PGP3A)) THEN + IF(.NOT.PRESENT(PSPSC3A)) THEN + CALL ABORT_TRANS('DIR_TRANS:PSPSC3A HAS TO BE PRESENT WHEN PGP3A IS') + ENDIF +ENDIF +IF(IF_SC3A_G > 0) THEN + IF(PRESENT(PGP3A)) THEN + IUBOUND=UBOUND(PGP3A) + IF(IUBOUND(1) < NPROMA) THEN + WRITE(NOUT,*)'DIR_TRANS:FIRST DIM. OF PGP3A TOO SMALL ',IUBOUND(1),NPROMA + CALL ABORT_TRANS('DIR_TRANS:FIRST DIMENSION OF PGP3A TOO SMALL ') + ENDIF + IF(IUBOUND(2) /= IF_SC3A_G) THEN + WRITE(NOUT,*)'DIR_TRANS:SEC DIM. OF PGP3A INCONSISTENT ',IUBOUND(2),IF_SC3A_G + CALL ABORT_TRANS('DIR_TRANS:SEC. DIMENSION OF PGP3A INCONSISTENT ') + ENDIF + IF(IUBOUND(3) /= UBOUND(PSPSC3A,3) ) THEN + WRITE(NOUT,*)'DIR_TRANS:THIRD DIM. OF PGP3A INCONSISTENT ',& + & IUBOUND(3),UBOUND(PSPSC3A,3) + CALL ABORT_TRANS('DIR_TRANS:THIRD DIMENSION OF PGP3A INCONSISTENT ') + ENDIF + IF(IUBOUND(4) < NGPBLKS) THEN + WRITE(NOUT,*)'DIR_TRANS:FOURTH DIM. OF PGP3A TOO SMALL ',IUBOUND(4),NGPBLKS + CALL ABORT_TRANS('DIR_TRANS:FOURTH DIMENSION OF PGP3A TOO SMALL ') + ENDIF + ELSE + CALL ABORT_TRANS('DIR_TRANS:PGP3A MISSING') + ENDIF +ENDIF + +IF(PRESENT(PGP3B)) THEN + IF(.NOT.PRESENT(PSPSC3B)) THEN + CALL ABORT_TRANS('DIR_TRANS:PSPSC3B HAS TO BE PRESENT WHEN PGP3B IS') + ENDIF +ENDIF +IF(IF_SC3B_G > 0) THEN + IF(PRESENT(PGP3B)) THEN + IUBOUND=UBOUND(PGP3B) + IF(IUBOUND(1) < NPROMA) THEN + WRITE(NOUT,*)'DIR_TRANS:FIRST DIM. OF PGP3B TOO SMALL ',IUBOUND(1),NPROMA + CALL ABORT_TRANS('DIR_TRANS:FIRST DIMENSION OF PGP3B TOO SMALL ') + ENDIF + IF(IUBOUND(2) /= IF_SC3B_G) THEN + WRITE(NOUT,*)'DIR_TRANS:SEC DIM. OF PGP3B INCONSISTENT ',IUBOUND(2),IF_SC3B_G + CALL ABORT_TRANS('DIR_TRANS:SEC. DIMENSION OF PGP3B INCONSISTENT ') + ENDIF + IF(IUBOUND(3) /= UBOUND(PSPSC3B,3) ) THEN + WRITE(NOUT,*)'DIR_TRANS:THIRD DIM. OF PGP3B INCONSISTENT ',& + & IUBOUND(3),UBOUND(PSPSC3B,3) + CALL ABORT_TRANS('DIR_TRANS:THIRD DIMENSION OF PGP3B INCONSISTENT ') + ENDIF + IF(IUBOUND(4) < NGPBLKS) THEN + WRITE(NOUT,*)'DIR_TRANS:FOURTH DIM. OF PGP3B TOO SMALL ',IUBOUND(4),NGPBLKS + CALL ABORT_TRANS('DIR_TRANS:FOURTH DIMENSION OF PGP3B TOO SMALL ') + ENDIF + ELSE + CALL ABORT_TRANS('DIR_TRANS:PGP3B MISSING') + ENDIF +ENDIF +CALL GSTATS(1810,1) + +! Perform transform + +CALL EDIR_TRANS_CTLAD(IF_UV_G,IF_SCALARS_G,IF_GP,IF_FS,IF_UV,IF_SCALARS,& + & PSPVOR,PSPDIV,PSPSCALAR,KVSETUV,KVSETSC,PGP,& + & PSPSC3A,PSPSC3B,PSPSC2,KVSETSC3A,KVSETSC3B,KVSETSC2,PGPUV,PGP3A,PGP3B,PGP2,& + & PMEANU,PMEANV) +IF (LHOOK) CALL DR_HOOK('EDIR_TRANSAD',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ +!endif INTERFACE + +END SUBROUTINE EDIR_TRANSAD + diff --git a/src/etrans/etrans/external/edist_grid.F90 b/src/etrans/etrans/external/edist_grid.F90 new file mode 100644 index 000000000..78559288b --- /dev/null +++ b/src/etrans/etrans/external/edist_grid.F90 @@ -0,0 +1,136 @@ +SUBROUTINE EDIST_GRID(PGPG,KPROMA,KFDISTG,KFROM,KRESOL,PGP,KSORT) + +!**** *EDIST_GRID* - Distribute global gridpoint array among processors + +! Purpose. +! -------- +! Interface routine for distributing gridpoint array + +!** Interface. +! ---------- +! CALL EDIST_GRID(...) + +! Explicit arguments : +! -------------------- +! PGPG(:,:) - Global spectral array +! KFDISTG - Global number of fields to be distributed +! KPROMA - required blocking factor for gridpoint input +! KFROM(:) - Processor resposible for distributing each field +! KRESOL - resolution tag which is required ,default is the +! first defined resulution (input) +! PGP(:,:) - Local spectral array + +! Method. +! ------- + +! Externals. ESET_RESOL - set resolution +! ---------- DIST_GRID_CTL - control routine + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-03-03 +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! P.Marguinaud 10-Oct-2014 Add KSORT argument + +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +!ifndef INTERFACE + +USE TPM_GEN ,ONLY : NERR, NOUT +!USE TPM_DIM +USE TPM_DISTR ,ONLY : D, MYPROC, NPROC + +USE ESET_RESOL_MOD ,ONLY : ESET_RESOL +USE DIST_GRID_CTL_MOD ,ONLY : DIST_GRID_CTL +USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS + +!endif INTERFACE + +IMPLICIT NONE + +! Declaration of arguments + +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PGPG(:,:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KPROMA +INTEGER(KIND=JPIM) , INTENT(IN) :: KFDISTG +INTEGER(KIND=JPIM) , INTENT(IN) :: KFROM(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KRESOL +REAL(KIND=JPRB) , INTENT(OUT) :: PGP(:,:,:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KSORT (:) +!ifndef INTERFACE + +INTEGER(KIND=JPIM) :: IFSEND,J,IUBOUND(3),IPROMA,IGPBLKS +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +! Set current resolution +IF (LHOOK) CALL DR_HOOK('EDIST_GRID',0,ZHOOK_HANDLE) +CALL ESET_RESOL(KRESOL) + +IPROMA = D%NGPTOT +IF(PRESENT(KPROMA)) THEN + IPROMA = KPROMA +ENDIF +IGPBLKS = (D%NGPTOT-1)/IPROMA+1 + +IF(UBOUND(KFROM,1) < KFDISTG) THEN + CALL ABORT_TRANS('EDIST_GRID: KFROM TOO SHORT!') +ENDIF +IFSEND = 0 +DO J=1,KFDISTG + IF(KFROM(J) < 1 .OR. KFROM(J) > NPROC) THEN + WRITE(NERR,*) 'EDIST_GRID:ILLEGAL KFROM VALUE',KFROM(J),J + CALL ABORT_TRANS('EDIST_GRID:ILLEGAL KFROM VALUE') + ENDIF + IF(KFROM(J) == MYPROC) IFSEND = IFSEND+1 +ENDDO + +IUBOUND=UBOUND(PGP) +IF(IUBOUND(1) < IPROMA) THEN + WRITE(NOUT,*)'EDIST_GRID:FIRST DIM. OF PGP TOO SMALL ',IUBOUND(1),IPROMA + CALL ABORT_TRANS('EDIST_GRID:FIRST DIMENSION OF PGP TOO SMALL ') +ENDIF +IF(IUBOUND(2) < KFDISTG) THEN + WRITE(NOUT,*)'EDIST_GRID:SEC. DIM. OF PGP TOO SMALL ',IUBOUND(2),KFDISTG + CALL ABORT_TRANS('EDIST_GRID:SECOND DIMENSION OF PGP TOO SMALL ') +ENDIF +IF(IUBOUND(3) < IGPBLKS) THEN + WRITE(NOUT,*)'EDIST_GRID:THIRD DIM. OF PGP TOO SMALL ',IUBOUND(3),IGPBLKS + CALL ABORT_TRANS('EDIST_GRID:THIRD DIMENSION OF PGP TOO SMALL ') +ENDIF + +IF(IFSEND > 0) THEN + IF(.NOT.PRESENT(PGPG)) THEN + CALL ABORT_TRANS('EDIST_GRID:PGPG MISSING') + ENDIF + IF(UBOUND(PGPG,1) < D%NGPTOTG) THEN + CALL ABORT_TRANS('EDIST_GRID:FIRST DIMENSION OF PGPG TOO SMALL') + ENDIF + IF(UBOUND(PGPG,2) < IFSEND) THEN + CALL ABORT_TRANS('EDIST_GRID:FIRST DIMENSION OF PGPG TOO SMALL') + ENDIF +ENDIF + +IF (PRESENT (KSORT)) THEN + IF (UBOUND (KSORT, 1) /= UBOUND (PGP, 2)) THEN + CALL ABORT_TRANS('EDIST_GRID: DIMENSION MISMATCH KSORT, PGP') + ENDIF +ENDIF + +CALL DIST_GRID_CTL(PGPG,KFDISTG,IPROMA,KFROM,PGP,KSORT) +IF (LHOOK) CALL DR_HOOK('EDIST_GRID',1,ZHOOK_HANDLE) + +!endif INTERFACE + +! ------------------------------------------------------------------ + +END SUBROUTINE EDIST_GRID + diff --git a/src/etrans/etrans/external/edist_spec.F90 b/src/etrans/etrans/external/edist_spec.F90 new file mode 100644 index 000000000..eeaa512ce --- /dev/null +++ b/src/etrans/etrans/external/edist_spec.F90 @@ -0,0 +1,195 @@ +SUBROUTINE EDIST_SPEC(PSPECG,KFDISTG,KFROM,KVSET,KRESOL,PSPEC,& + & LDIM1_IS_FLD,KSORT) + +!**** *EDIST_SPEC* - Distribute global spectral array among processors + +! Purpose. +! -------- +! Interface routine for distributing spectral array + +!** Interface. +! ---------- +! CALL EDIST__SPEC(...) + +! Explicit arguments : +! -------------------- +! PSPECG(:,:) - Global spectral array +! KFDISTG - Global number of fields to be distributed +! KFROM(:) - Processor resposible for distributing each field +! KVSET(:) - "B-Set" for each field +! KRESOL - resolution tag which is required ,default is the +! first defined resulution (input) +! PSPEC(:,:) - Local spectral array + +! Method. +! ------- + +! Externals. ESET_RESOL - set resolution +! ---------- DIST_SPEC_CONTROL - control routine + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-03-03 +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! P.Marguinaud 10-Oct-2014 Add KSORT argument (change the order of fields) + +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +!ifndef INTERFACE + +USE TPM_GEN ,ONLY : NERR +USE TPM_DIM ,ONLY : R +USE TPMALD_DIM ,ONLY : RALD +USE TPM_DISTR ,ONLY : D, NPRTRV, NPRTRW, MYSETV, MYPROC, NPROC +USE TPMALD_DISTR ,ONLY : DALD + +USE ESET_RESOL_MOD ,ONLY : ESET_RESOL +USE DIST_SPEC_CONTROL_MOD ,ONLY : DIST_SPEC_CONTROL +USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS + +!endif INTERFACE + +IMPLICIT NONE + +! Declaration of arguments + +REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PSPECG(:,:) +INTEGER(KIND=JPIM),INTENT(IN) :: KFDISTG +INTEGER(KIND=JPIM),INTENT(IN) :: KFROM(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KVSET(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KRESOL +LOGICAL ,OPTIONAL,INTENT(IN) :: LDIM1_IS_FLD +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PSPEC(:,:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KSORT (:) +!ifndef INTERFACE + +INTEGER(KIND=JPIM) :: IVSET(KFDISTG) +INTEGER(KIND=JPIM) :: IFSEND,IFRECV,J, IFLD, ICOEFF +INTEGER(KIND=JPIM) :: ISMAX, ISPEC2, ISPEC2_G, ISPEC2MX +INTEGER(KIND=JPIM) :: IPOSSP(NPRTRW+1) +INTEGER(KIND=JPIM) :: IUMPP(NPRTRW) +INTEGER(KIND=JPIM) :: IPTRMS(NPRTRW) +INTEGER(KIND=JPIM),ALLOCATABLE :: IDIM0G(:) +INTEGER(KIND=JPIM),ALLOCATABLE :: IALLMS(:) +INTEGER(KIND=JPIM),ALLOCATABLE :: IKN(:) +LOGICAL :: LLDIM1_IS_FLD +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE +! ------------------------------------------------------------------ + +! Set current resolution +IF (LHOOK) CALL DR_HOOK('EDIST_SPEC',0,ZHOOK_HANDLE) +CALL ESET_RESOL(KRESOL) + +LLDIM1_IS_FLD=.TRUE. +IF(PRESENT(LDIM1_IS_FLD)) LLDIM1_IS_FLD=LDIM1_IS_FLD +IF(LLDIM1_IS_FLD) THEN + IFLD=1 + ICOEFF=2 +ELSE + IFLD=2 + ICOEFF=1 +ENDIF + +ISMAX = RALD%NMSMAX +ALLOCATE(IDIM0G(0:ISMAX)) +ALLOCATE(IALLMS(ISMAX+1)) +ALLOCATE(IKN(0:ISMAX)) +ISPEC2 = D%NSPEC2 +ISPEC2_G = R%NSPEC2_G +IPOSSP(:) = D%NPOSSP(:) +IDIM0G(:) = D%NDIM0G(:) +ISPEC2MX = D%NSPEC2MX +IUMPP(:) = D%NUMPP(:) +IALLMS(:) = D%NALLMS(:) +IPTRMS(:) = D%NPTRMS(:) +DO J=0,ISMAX + IKN(J)=2*DALD%NCPL2M(J) +ENDDO + +IF(UBOUND(KFROM,1) < KFDISTG) THEN + CALL ABORT_TRANS('EDIST_SPEC: KFROM TOO SHORT!') +ENDIF + +IFSEND = 0 +IFRECV = 0 + +DO J=1,KFDISTG + IF(KFROM(J) < 1 .OR. KFROM(J) > NPROC) THEN + WRITE(NERR,*) 'EDIST_SPEC:ILLEGAL KFROM VALUE',KFROM(J),J + CALL ABORT_TRANS('EDIST_SPEC:ILLEGAL KFROM VALUE') + ENDIF + IF(KFROM(J) == MYPROC) IFSEND = IFSEND+1 +ENDDO + +IF(IFSEND > 0) THEN + IF(.NOT.PRESENT(PSPECG)) THEN + CALL ABORT_TRANS('EDIST_SPEC:PSPECG MISSING') + ENDIF + IF(UBOUND(PSPECG,IFLD) < IFSEND) THEN + WRITE(NERR,*)'EDIST_SPEC: ',IFLD, UBOUND(PSPECG,IFLD), IFSEND + CALL ABORT_TRANS('EDIST_SPEC:FIELD DIMENSION OF PSPECG TOO SMALL') + ENDIF + IF(UBOUND(PSPECG,ICOEFF) < ISPEC2_G) THEN + WRITE(NERR,*)'EDIST_SPEC: ',ICOEFF, UBOUND(PSPECG,ICOEFF), ISPEC2_G + CALL ABORT_TRANS('EDIST_SPEC: COEFF DIMENSION OF PSPECG TOO SMALL') + ENDIF +ENDIF + +IF(PRESENT(KVSET)) THEN + IF(UBOUND(KVSET,1) < KFDISTG) THEN + CALL ABORT_TRANS('EDIST_SPEC: KVSET TOO SHORT!') + ENDIF + DO J=1,KFDISTG + IF(KVSET(J) > NPRTRV .OR. KVSET(J) < 1) THEN + WRITE(NERR,*) 'EDIST_SPEC:KVSET(J) > NPRTRV ',J,KVSET(J),NPRTRV + CALL ABORT_TRANS('EDIST_SPEC:KVSET CONTAINS VALUES OUTSIDE RANGE') + ENDIF + IF(KVSET(J) == MYSETV) THEN + IFRECV = IFRECV+1 + ENDIF + ENDDO + IVSET(:) = KVSET(1:KFDISTG) +ELSE + IFRECV = KFDISTG + IVSET(:) = MYSETV +ENDIF + +IF(IFRECV > 0 ) THEN + IF(.NOT.PRESENT(PSPEC)) THEN + CALL ABORT_TRANS('EDIST_SPEC: FIELDS TO RECEIVE AND PSPEC NOT PRESENT') + ENDIF + IF(UBOUND(PSPEC,IFLD) < IFRECV) THEN + CALL ABORT_TRANS('EDIST_SPEC: FIELD DIMENSION OF PSPEC TOO SMALL') + ENDIF + IF(UBOUND(PSPEC,ICOEFF) < ISPEC2 ) THEN + CALL ABORT_TRANS('EDIST_SPEC: COEFF DIMENSION OF PSPEC TOO SMALL') + ENDIF +ENDIF + +IF (PRESENT (KSORT)) THEN + IF (.NOT. PRESENT (PSPEC)) THEN + CALL ABORT_TRANS('EDIST_SPEC: KSORT REQUIRES PSPEC') + ENDIF + IF (UBOUND (KSORT, 1) /= UBOUND (PSPEC, IFLD)) THEN + CALL ABORT_TRANS('EDIST_SPEC: DIMENSION MISMATCH KSORT, PSPEC') + ENDIF +ENDIF + +CALL DIST_SPEC_CONTROL(PSPECG,KFDISTG,KFROM,IVSET,PSPEC,LLDIM1_IS_FLD,& + & ISMAX,ISPEC2,ISPEC2MX,ISPEC2_G,IPOSSP,IDIM0G,IUMPP,IALLMS,IPTRMS,IKN,KSORT) +DEALLOCATE(IDIM0G) +IF (LHOOK) CALL DR_HOOK('EDIST_SPEC',1,ZHOOK_HANDLE) + +!endif INTERFACE + +! ------------------------------------------------------------------ + +END SUBROUTINE EDIST_SPEC + diff --git a/src/etrans/etrans/external/egath_grid.F90 b/src/etrans/etrans/external/egath_grid.F90 new file mode 100644 index 000000000..05455b522 --- /dev/null +++ b/src/etrans/etrans/external/egath_grid.F90 @@ -0,0 +1,129 @@ +SUBROUTINE EGATH_GRID(PGPG,KPROMA,KFGATHG,KTO,KRESOL,PGP) + +!**** *EGATH_GRID* - Gather global gridpoint array from processors + +! Purpose. +! -------- +! Interface routine for gathering gripoint array + +!** Interface. +! ---------- +! CALL EGATH_GRID(...) + +! Explicit arguments : +! -------------------- +! PGPG(:,:) - Global gridpoint array +! KFGATHG - Global number of fields to be gathered +! KPROMA - blocking factor for gridpoint input +! KTO(:) - Processor responsible for gathering each field +! KRESOL - resolution tag which is required ,default is the +! first defined resulution (input) +! PGP(:,:,:) - Local spectral array + +! Method. +! ------- + +! Externals. SET_RESOL - set resolution +! ---------- GATH_GRID_CTL - control routine + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-03-03 +! M.Hamrud 01-Oct-2003 CY28 Cleaning + +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +!ifndef INTERFACE + +USE TPM_GEN ,ONLY : NERR, NOUT +!USE TPM_DIM +USE TPM_DISTR ,ONLY : D, MYPROC, NPROC + +USE ESET_RESOL_MOD ,ONLY : ESET_RESOL +USE GATH_GRID_CTL_MOD ,ONLY : GATH_GRID_CTL +USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS + +!endif INTERFACE + +IMPLICIT NONE + +! Declaration of arguments + +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PGPG(:,:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KPROMA +INTEGER(KIND=JPIM),INTENT(IN) :: KFGATHG +INTEGER(KIND=JPIM),INTENT(IN) :: KTO(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KRESOL +REAL(KIND=JPRB) ,INTENT(IN) :: PGP(:,:,:) +!ifndef INTERFACE + +INTEGER(KIND=JPIM) :: IFRECV,J,IUBOUND(3),IPROMA,IGPBLKS +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +! Set current resolution +IF (LHOOK) CALL DR_HOOK('EGATH_GRID',0,ZHOOK_HANDLE) +CALL ESET_RESOL(KRESOL) + +IPROMA = D%NGPTOT +IF(PRESENT(KPROMA)) THEN + IPROMA = KPROMA +ENDIF +IGPBLKS = (D%NGPTOT-1)/IPROMA+1 + +IF(UBOUND(KTO,1) < KFGATHG) THEN + CALL ABORT_TRANS('GATH_GRID: KTO TOO SHORT!') +ENDIF + +IFRECV = 0 +DO J=1,KFGATHG + IF(KTO(J) < 1 .OR. KTO(J) > NPROC) THEN + WRITE(NERR,*) 'GATH_GRID:ILLEGAL KTO VALUE',KTO(J),J + CALL ABORT_TRANS('GATH_GRID:ILLEGAL KTO VALUE') + ENDIF + IF(KTO(J) == MYPROC) IFRECV = IFRECV+1 +ENDDO + +IUBOUND=UBOUND(PGP) +IF(IUBOUND(1) < IPROMA) THEN + WRITE(NOUT,*)'GATH_GRID:FIRST DIM. OF PGP TOO SMALL ',IUBOUND(1),IPROMA + CALL ABORT_TRANS('GATH_GRID:FIRST DIMENSION OF PGP TOO SMALL ') +ENDIF +IF(IUBOUND(2) < KFGATHG) THEN + WRITE(NOUT,*)'GATH_GRID:SEC. DIM. OF PGP TOO SMALL ',IUBOUND(2),KFGATHG + CALL ABORT_TRANS('GATH_GRID:SECOND DIMENSION OF PGP TOO SMALL ') +ENDIF +IF(IUBOUND(3) < IGPBLKS) THEN + WRITE(NOUT,*)'GATH_GRID:THIRD DIM. OF PGP TOO SMALL ',IUBOUND(3),IGPBLKS + CALL ABORT_TRANS('GATH_GRID:THIRD DIMENSION OF PGP TOO SMALL ') +ENDIF + +IF(IFRECV > 0) THEN + IF(.NOT.PRESENT(PGPG)) THEN + CALL ABORT_TRANS('GATH_GRID:PGPG MISSING') + ENDIF + IF(UBOUND(PGPG,1) < D%NGPTOTG) THEN + CALL ABORT_TRANS('GATH_GRID:FIRST DIMENSION OF PGPG TOO SMALL') + ENDIF + IF(UBOUND(PGPG,2) < IFRECV) THEN + CALL ABORT_TRANS('GATH_GRID:SECOND DIMENSION OF PGPG TOO SMALL') + ENDIF +ENDIF + +CALL GATH_GRID_CTL(PGPG,KFGATHG,IPROMA,KTO,PGP) +IF (LHOOK) CALL DR_HOOK('EGATH_GRID',1,ZHOOK_HANDLE) + +!endif INTERFACE + +! ------------------------------------------------------------------ + +END SUBROUTINE EGATH_GRID + diff --git a/src/etrans/etrans/external/egath_spec.F90 b/src/etrans/etrans/external/egath_spec.F90 new file mode 100644 index 000000000..4b2bde0c3 --- /dev/null +++ b/src/etrans/etrans/external/egath_spec.F90 @@ -0,0 +1,203 @@ +SUBROUTINE EGATH_SPEC(PSPECG,KFGATHG,KTO,KVSET,KRESOL,PSPEC,LDIM1_IS_FLD,KSMAX,KMSMAX,LDZA0IP) + +!**** *EGATH_SPEC* - Gather global spectral array from processors + +! Purpose. +! -------- +! Interface routine for gathering spectral array + +!** Interface. +! ---------- +! CALL EGATH_SPEC(...) + +! Explicit arguments : +! -------------------- +! PSPECG(:,:) - Global spectral array +! KFGATHG - Global number of fields to be gathered +! KTO(:) - Processor responsible for gathering each field +! KVSET(:) - "B-Set" for each field +! KRESOL - resolution tag which is required ,default is the +! first defined resulution (input) +! PSPEC(:,:) - Local spectral array +! LDZA0IP - Set to zero imaginary part of first coefficients + +! +! Method. +! ------- + +! Externals. SET_RESOL - set resolution +! ---------- GATH_SPEC_CONTROL - control routine + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-03-03 +! Modified 03-09-30 Y. Seity, bug correction IFSEND=0 +! R. El Khatib 23-Oct-2012 Monkey business +! P.Marguinaud 10-Oct-2013 Add an option to set (or not) first +! coefficients imaginary part to zero +! R. El Khatib 01-Dec-2020 Merge egath_spec_control and gath_spec_control +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB + +!ifndef INTERFACE + +USE TPM_GEN ,ONLY : NERR +USE TPM_DIM ,ONLY : R +USE TPMALD_DIM ,ONLY : RALD +USE TPM_DISTR ,ONLY : D, NPRTRV, NPRTRW, MYSETV, MYPROC, NPROC +USE TPMALD_DISTR + +USE ESET_RESOL_MOD ,ONLY : ESET_RESOL +USE GATH_SPEC_CONTROL_MOD ,ONLY : GATH_SPEC_CONTROL + +USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +!endif INTERFACE + +IMPLICIT NONE + +! Declaration of arguments + +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPECG(:,:) +INTEGER(KIND=JPIM) , INTENT(IN) :: KFGATHG +INTEGER(KIND=JPIM) , INTENT(IN) :: KTO(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSET(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KRESOL +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPEC(:,:) +LOGICAL ,OPTIONAL, INTENT(IN) :: LDIM1_IS_FLD +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KSMAX +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KMSMAX +LOGICAL ,OPTIONAL, INTENT(IN) :: LDZA0IP + +!ifndef INTERFACE + +INTEGER(KIND=JPIM) :: IVSET(KFGATHG) +INTEGER(KIND=JPIM) :: IFRECV,IFSEND,J +INTEGER(KIND=JPIM) :: IFLD,ICOEFF +INTEGER(KIND=JPIM) :: ISMAX, IMSMAX, ISPEC2, ISPEC2_G,ISPEC2MX +INTEGER(KIND=JPIM) :: IPOSSP(NPRTRW+1) +INTEGER(KIND=JPIM) :: IUMPP(NPRTRW) +INTEGER(KIND=JPIM) :: IPTRMS(NPRTRW) +INTEGER(KIND=JPIM),ALLOCATABLE :: IDIM0G(:) +INTEGER(KIND=JPIM),ALLOCATABLE :: IALLMS(:) +INTEGER(KIND=JPIM),ALLOCATABLE :: IKN(:) +LOGICAL :: LLDIM1_IS_FLD +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +IF (LHOOK) CALL DR_HOOK('EGATH_SPEC',0,ZHOOK_HANDLE) +! Set current resolution +CALL ESET_RESOL(KRESOL) + +LLDIM1_IS_FLD = .TRUE. +IF(PRESENT(LDIM1_IS_FLD)) LLDIM1_IS_FLD = LDIM1_IS_FLD + +IF(LLDIM1_IS_FLD) THEN + IFLD = 1 + ICOEFF = 2 +ELSE + IFLD = 2 + ICOEFF = 1 +ENDIF +IF(UBOUND(KTO,1) < KFGATHG) THEN + CALL ABORT_TRANS('EGATH_SPEC: KTO TOO SHORT!') +ENDIF + +ISMAX = R%NSMAX +IMSMAX = RALD%NMSMAX +IF(PRESENT(KSMAX)) ISMAX = KSMAX +IF(PRESENT(KMSMAX)) IMSMAX = KMSMAX +ALLOCATE(IDIM0G(0:IMSMAX)) +ALLOCATE(IALLMS(IMSMAX+1)) +ALLOCATE(IKN(0:IMSMAX)) +IF(IMSMAX /= RALD%NMSMAX .OR. ISMAX /= R%NSMAX) THEN + CALL ABORT_TRANS('EGATH_SPEC:TRUNCATION CHANGE NOT YET CODED') +ELSE + ISPEC2 = D%NSPEC2 + ISPEC2_G = R%NSPEC2_G + IPOSSP(:) = D%NPOSSP(:) + IDIM0G(:) = D%NDIM0G(:) + ISPEC2MX = D%NSPEC2MX + IUMPP(:) = D%NUMPP(:) + IALLMS(:) = D%NALLMS(:) + IPTRMS(:) = D%NPTRMS(:) + DO J=0,IMSMAX + IKN(J)=2*DALD%NCPL2M(J) + ENDDO +ENDIF + +IFSEND = 0 +IFRECV = 0 +DO J=1,KFGATHG + IF(KTO(J) < 1 .OR. KTO(J) > NPROC) THEN + WRITE(NERR,*) 'EGATH_SPEC:ILLEGAL KTO VALUE',KTO(J),J + CALL ABORT_TRANS('EGATH_SPEC:ILLEGAL KTO VALUE') + ENDIF + IF(KTO(J) == MYPROC) IFRECV = IFRECV+1 +ENDDO + +IF(IFRECV > 0) THEN + IF(.NOT.PRESENT(PSPECG)) THEN + CALL ABORT_TRANS('EGATH_SPEC:PSPECG MISSING') + ENDIF + IF(UBOUND(PSPECG,IFLD) < IFRECV) THEN + WRITE(NERR,*) 'EGATH_SPEC: ',IFLD, UBOUND(PSPECG,IFLD), IFRECV + CALL ABORT_TRANS('EGATH_SPEC:FIELD DIMENSION OF PSPECG TOO SMALL') + ENDIF + IF(UBOUND(PSPECG,ICOEFF) < ISPEC2_G) THEN + WRITE(NERR,*) 'EGATH_SPEC: ',ICOEFF, UBOUND(PSPECG,ICOEFF), ISPEC2_G + CALL ABORT_TRANS('EGATH_SPEC:COEFF DIMENSION OF PSPECG TOO SMALL') + ENDIF +ENDIF + +IF(PRESENT(KVSET)) THEN + IF(UBOUND(KVSET,1) < KFGATHG) THEN + CALL ABORT_TRANS('EGATH_SPEC: KVSET TOO SHORT!') + ENDIF + DO J=1,KFGATHG + IF(KVSET(J) > NPRTRV .OR. KVSET(J) < 1) THEN + WRITE(NERR,*) 'EGATH_SPEC:KVSET(J) > NPRTRV ',J,KVSET(J),NPRTRV + CALL ABORT_TRANS('EGATH_SPEC:KVSET CONTAINS VALUES OUTSIDE RANGE') + ENDIF + IF(KVSET(J) == MYSETV) THEN + IFSEND = IFSEND+1 + ENDIF + ENDDO + IVSET(:) = KVSET(1:KFGATHG) +ELSEIF(NPRTRV > 1) THEN + WRITE(NERR,*) 'EGATH_SPEC:KVSET MISSING, NPRTRV ',NPRTRV + CALL ABORT_TRANS('EGATH_SPEC:KVSET MISSING, NPRTRV > 1') +ELSE + IFSEND = KFGATHG + IVSET(:) = 1 +ENDIF + +IF(IFSEND > 0 ) THEN + IF(.NOT.PRESENT(PSPEC)) THEN + CALL ABORT_TRANS('EGATH_SPEC: FIELDS TO RECIEVE AND PSPEC NOT PRESENT') + ENDIF + IF(UBOUND(PSPEC,IFLD) < IFSEND) THEN + CALL ABORT_TRANS('EGATH_SPEC: FIELD DIMENSION OF PSPEC TOO SMALL') + ENDIF + IF(UBOUND(PSPEC,ICOEFF) < ISPEC2 ) THEN + CALL ABORT_TRANS('EGATH_SPEC: COEFF DIMENSION OF PSPEC TOO SMALL') + ENDIF +ENDIF + +CALL GATH_SPEC_CONTROL(PSPECG,KFGATHG,KTO,IVSET,PSPEC,LLDIM1_IS_FLD,& + & IMSMAX,ISPEC2,ISPEC2MX,ISPEC2_G,IPOSSP,IDIM0G,IUMPP,IALLMS,IPTRMS,IKN,LDZA0IP) +DEALLOCATE(IDIM0G) + +IF (LHOOK) CALL DR_HOOK('EGATH_SPEC',1,ZHOOK_HANDLE) +!endif INTERFACE + +! ------------------------------------------------------------------ + +END SUBROUTINE EGATH_SPEC diff --git a/src/etrans/etrans/external/egpnorm_trans.F90 b/src/etrans/etrans/external/egpnorm_trans.F90 new file mode 100644 index 000000000..3c2b32906 --- /dev/null +++ b/src/etrans/etrans/external/egpnorm_trans.F90 @@ -0,0 +1,93 @@ +SUBROUTINE EGPNORM_TRANS(PGP,KFIELDS,KPROMA,PAVE,PMIN,PMAX,LDAVE_ONLY,KRESOL) + + +!**** *EGPNORM_TRANS* - calculate grid-point norms + +! Purpose. +! -------- +! calculate grid-point norms + +!** Interface. +! ---------- +! CALL EGPNORM_TRANS(...) + +! Explicit arguments : +! -------------------- +! PGP(:,:,:) - gridpoint fields (input) +! PGP is dimensioned (NPROMA,KFIELDS,NGPBLKS) where +! NPROMA is the blocking factor, KFIELDS the total number +! of fields and NGPBLKS the number of NPROMA blocks. +! KFIELDS - number of fields (input) +! (these do not have to be just levels) +! KPROMA - required blocking factor (input) +! PAVE - average (output) +! PMIN - minimum (input/output) +! PMAX - maximum (input/output) +! LDAVE_ONLY - T : PMIN and PMAX already contain local MIN and MAX +! KRESOL - resolution tag (optional) +! default assumes first defined resolution +! + +! Author. +! ------- +! George Mozdzynski *ECMWF* + +! Modifications. +! -------------- +! Original : 19th Sept 2008 +! R. El Khatib 07-08-2009 Optimisation directive for NEC +! R. El Khatib 16-Sep-2019 merge with global model code +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB, JPRD + +!ifndef INTERFACE + +USE TPM_DIM ,ONLY : R +USE TPM_GEOMETRY ,ONLY : G +USE TPM_DIM ,ONLY : R +USE ESET_RESOL_MOD ,ONLY : ESET_RESOL +USE GPNORM_TRANS_CTL_MOD, ONLY : GPNORM_TRANS_CTL +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +!endif INTERFACE + +IMPLICIT NONE + +! Declaration of arguments + +REAL(KIND=JPRB) ,INTENT(IN) :: PGP(:,:,:) +REAL(KIND=JPRB) ,INTENT(OUT) :: PAVE(:) +REAL(KIND=JPRB) ,INTENT(INOUT) :: PMIN(:) +REAL(KIND=JPRB) ,INTENT(INOUT) :: PMAX(:) +INTEGER(KIND=JPIM),INTENT(IN) :: KFIELDS +INTEGER(KIND=JPIM),INTENT(IN) :: KPROMA +LOGICAL ,INTENT(IN) :: LDAVE_ONLY +INTEGER(KIND=JPIM),OPTIONAL, INTENT(IN) :: KRESOL + +!ifndef INTERFACE + +! Local variables +INTEGER(KIND=JPIM) :: JGL +REAL(KIND=JPRB) :: ZW(R%NDGL) + +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE +! ------------------------------------------------------------------ +IF (LHOOK) CALL DR_HOOK('EGPNORM_TRANS',0,ZHOOK_HANDLE) + +! Set current resolution +CALL ESET_RESOL(KRESOL) + +DO JGL=1,R%NDGL + ZW(1:)=1._JPRB/G%NLOEN(JGL) +ENDDO +CALL GPNORM_TRANS_CTL(PGP,KFIELDS,KPROMA,PAVE,PMIN,PMAX,LDAVE_ONLY,ZW(1:R%NDGL)) + +IF (LHOOK) CALL DR_HOOK('EGPNORM_TRANS',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +!endif INTERFACE + + +END SUBROUTINE EGPNORM_TRANS diff --git a/src/etrans/etrans/external/einv_trans.F90 b/src/etrans/etrans/external/einv_trans.F90 new file mode 100644 index 000000000..25f47c07a --- /dev/null +++ b/src/etrans/etrans/external/einv_trans.F90 @@ -0,0 +1,607 @@ +SUBROUTINE EINV_TRANS(PSPVOR,PSPDIV,PSPSCALAR,PSPSC3A,PSPSC3B,PSPSC2,& + & FSPGL_PROC,& + & LDSCDERS,LDVORGP,LDDIVGP,LDUVDER,KPROMA,KVSETUV,KVSETSC,KRESOL,& + & KVSETSC3A,KVSETSC3B,KVSETSC2,& + & PGP,PGPUV,PGP3A,PGP3B,PGP2,PMEANU,PMEANV) + +!**** *EINV_TRANS* - Inverse spectral transform. + +! Purpose. +! -------- +! Interface routine for the inverse spectral transform + +!** Interface. +! ---------- +! CALL EINV_TRANS(...) + +! Explicit arguments : All arguments are optional. +! -------------------- +! PSPVOR(:,:) - spectral vorticity (input) +! PSPDIV(:,:) - spectral divergence (input) +! PSPSCALAR(:,:) - spectral scalarvalued fields (input) +! PSPSC3A(:,:,:) - alternative to use of PSPSCALAR, see PGP3A below (input) +! PSPSC3B(:,:,:) - alternative to use of PSPSCALAR, see PGP3B below (input) +! PSPSC2(:,:) - alternative to use of PSPSCALAR, see PGP2 below (input) +! FSPGL_PROC - external procedure to be executed in fourier space +! before transposition +! LDSCDERS - indicating if derivatives of scalar variables are req. +! LDVORGP - indicating if grid-point vorticity is req. +! LDDIVGP - indicating if grid-point divergence is req. +! LDUVDER - indicating if E-W derivatives of u and v are req. +! KPROMA - required blocking factor for gridpoint output +! KVSETUV(:) - indicating which 'b-set' in spectral space owns a +! vor/div field. Equivalant to NBSETLEV in the IFS. +! The length of KVSETUV should be the GLOBAL number +! of u/v fields which is the dimension of u and v releated +! fields in grid-point space. +! KVESETSC(:) - indicating which 'b-set' in spectral space owns a +! scalar field. As for KVSETUV this argument is required +! if the total number of processors is greater than +! the number of processors used for distribution in +! spectral wave space. +! KVSETSC3A(:) - as KVESETSC for PSPSC3A (distribution on first dimension) +! KVSETSC3B(:) - as KVESETSC for PSPSC3B (distribution on first dimension) +! KVSETSC2(:) - as KVESETSC for PSPSC2 (distribution on first dimension) +! KRESOL - resolution tag which is required ,default is the +! first defined resulution (input) +! PGP(:,:,:) - gridpoint fields (output) +! PGP need to dimensioned (NPROMA,IF_GP,NGPBLKS) where +! NPROMA is the blocking factor, IF_GP the total number +! of output fields and NGPBLKS the number of NPROMA blocks. +! The ordering of the output fields is as follows (all +! parts are optional depending on the input switches): + +! vorticity : IF_UV_G fields (if psvor present and LDVORGP) +! divergence : IF_UV_G fields (if psvor present and LDDIVGP) +! u : IF_UV_G fields (if psvor present) +! v : IF_UV_G fields (if psvor present) +! scalar fields : IF_SCALARS_G fields (if pspscalar present) +! N-S derivative of scalar fields : IF_SCALARS_G fields (if pspscalar +! present and LDSCDERS) +! E-W derivative of u : IF_UV_G fields (if psvor present and and LDUVDER) +! E-W derivative of v : IF_UV_G fields (if psvor present and and LDUVDER) +! E-W derivative of scalar fields : IF_SCALARS_G fields (if pspscalar +! present and LDSCDERS) + +! Here IF_UV_G is the GLOBAL number of u/v fields as given by the length +! of KVSETUV (or by PSPVOR if no split in spectral 'b-set' direction +! IF_SCALARS_G is the GLOBAL number of scalar fields as giben by the +! length of KVESETSC (or by number of fields in PSPSCALAR if no spectral +! 'b-set' split + +! As an alternative to using PGP you can also use a combination of the +! following arrays. The reason for introducing these alternative ways +! of calling INV_TRANS is to avoid uneccessary copies where your data +! structures don't fit in to the 'PSPVOR,PSPDIV, PSPSCALAR, PGP' layout. +! The use of any of these precludes the use of PGP and vice versa. + +! PGPUV(:,:,:,:) - the 'u-v' related grid-point variables in the order +! described for PGP. The second dimension of PGPUV should +! be the same as the "global" first dimension of +! PSPVOR,PSPDIV (in the IFS this is the number of levels) +! PGPUV need to be dimensioned(NPROMA,ILEVS,IFLDS,NGPBLKS) +! IFLDS is the number of 'variables' (u,v,vor,div ...) +! PGP3A(:,:,:,:) - grid-point array directly connected with PSPSC3A +! dimensioned(NPROMA,ILEVS,IFLDS,NGPBLKS) +! IFLDS is the number of 'variables' (the same as in +! PSPSC3A if no derivatives, 3 times that with der.) +! PGP3B(:,:,:,:) - grid-point array directly connected with PSPSC3B +! dimensioned(NPROMA,ILEVS,IFLDS,NGPBLKS) +! IFLDS is the number of 'variables' (the same as in +! PSPSC3B if no derivatives, 3 times that with der.) +! PGP2(:,:,:) - grid-point array directly connected with PSPSC2 +! dimensioned(NPROMA,IFLDS,NGPBLKS) +! IFLDS is the number of 'variables' (the same as in +! PSPSC2 if no derivatives, 3 times that with der.) +! Method. +! ------- + +! Externals. SET_RESOL - set resolution +! ---------- LTINV_CTL - control of Legendre transform +! FTINV_CTL - control of Fourier transform + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-03-03 +! 26-02-03 Mats Hamrud & Gabor Radnoti : modified condition for scalar fields +! and derivatives (IF_SCALARS_G) +! Y. Seity and G. Radnoti : 03-09-29 : phasing for AL27 +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +!ifndef INTERFACE + +USE TPM_GEN ,ONLY : NERR, NOUT, NPROMATR +!USE TPM_DIM +USE TPM_TRANS ,ONLY : LDIVGP, LSCDERS, LUVDER, LVORGP, & + & NF_SC2, NF_SC3A, NF_SC3B, NGPBLKS, NPROMA +USE TPM_DISTR ,ONLY : D, NPRTRV, MYSETV +!USE TPM_GEOMETRY +!USE TPM_FIELDS +!USE TPM_FFT + +USE ESET_RESOL_MOD ,ONLY : ESET_RESOL +USE EINV_TRANS_CTL_MOD ,ONLY : EINV_TRANS_CTL +USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS + +!endif INTERFACE + +IMPLICIT NONE + +! Declaration of arguments + +REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PSPVOR(:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PSPDIV(:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PSPSCALAR(:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PSPSC3A(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PSPSC3B(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PSPSC2(:,:) +LOGICAL ,OPTIONAL,INTENT(IN) :: LDSCDERS +LOGICAL ,OPTIONAL,INTENT(IN) :: LDVORGP +LOGICAL ,OPTIONAL,INTENT(IN) :: LDDIVGP +LOGICAL ,OPTIONAL,INTENT(IN) :: LDUVDER +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KPROMA +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KVSETUV(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KVSETSC(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KRESOL +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KVSETSC3A(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KVSETSC3B(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KVSETSC2(:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PGP(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PGPUV(:,:,:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PGP3A(:,:,:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PGP3B(:,:,:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PGP2(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PMEANU(:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PMEANV(:) +EXTERNAL FSPGL_PROC +OPTIONAL FSPGL_PROC +!ifndef INTERFACE + +! Local varaibles +INTEGER(KIND=JPIM) :: IUBOUND(4),J +INTEGER(KIND=JPIM) :: IF_UV,IF_UV_G,IF_SCALARS,IF_SCALARS_G,IF_FS,IF_GP,IF_OUT_LT +INTEGER(KIND=JPIM) :: IF_SCDERS,IF_UV_PAR +INTEGER(KIND=JPIM) :: IF_SC2_G,IF_SC3A_G2,IF_SC3A_G3,IF_SC3B_G2,IF_SC3B_G3 +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE +! ------------------------------------------------------------------ + +IF (LHOOK) CALL DR_HOOK('EINV_TRANS',0,ZHOOK_HANDLE) +CALL GSTATS(1807,0) + +! Set current resolution +CALL ESET_RESOL(KRESOL) + +! Set defaults + +LVORGP = .FALSE. +LDIVGP = .FALSE. +LUVDER = .FALSE. +IF_UV = 0 +IF_UV_G = 0 +IF_UV_PAR = 0 +IF_SCALARS = 0 +IF_SCALARS_G = 0 +IF_SCDERS = 0 +NF_SC2 = 0 +NF_SC3A = 0 +NF_SC3B = 0 +IF_SC2_G = 0 +IF_SC3A_G2 = 0 +IF_SC3B_G2 = 0 +IF_SC3A_G3 = 0 +IF_SC3B_G3 = 0 +NPROMA = D%NGPTOT +LSCDERS = .FALSE. + +! Decide requirements + +IF(PRESENT(KVSETUV)) THEN + IF_UV_G = UBOUND(KVSETUV,1) + IF_UV_PAR = 2 + DO J=1,IF_UV_G + IF(KVSETUV(J) > NPRTRV .OR. KVSETUV(J) < 1) THEN + WRITE(NERR,*) 'INV_TRANS:KVSETUV(J) > NPRTRV ',J,KVSETUV(J),NPRTRV + CALL ABORT_TRANS('INV_TRANS:KVSETUV TOO LONG OR CONTAINS VALUES OUTSIDE RANGE') + ENDIF + IF(KVSETUV(J) == MYSETV) THEN + IF_UV = IF_UV+1 + ENDIF + ENDDO +ELSEIF(PRESENT(PSPVOR)) THEN + IF_UV = UBOUND(PSPVOR,1) + IF_UV_G = IF_UV + IF_UV_PAR = 2 +ENDIF + +IF(PRESENT(KVSETSC)) THEN + IF(.NOT. PRESENT(PSPSCALAR) ) THEN + CALL ABORT_TRANS('INV_TRANS : KVSETSC PRESENT BUT PSPSCALAR MISSING') + ENDIF + IF_SCALARS_G = UBOUND(KVSETSC,1) + DO J=1,IF_SCALARS_G + IF(KVSETSC(J) > NPRTRV .OR. KVSETSC(J) < 1) THEN + WRITE(NERR,*) 'INV_TRANS:KVSETSC(J) > NPRTRV ',J,KVSETSC(J),NPRTRV + CALL ABORT_TRANS('INV_TRANS:KVSETSC TOO LONG OR CONTAINS VALUES OUTSIDE RANGE') + ENDIF + IF(KVSETSC(J) == MYSETV) THEN + IF_SCALARS = IF_SCALARS+1 + ENDIF + ENDDO +ELSEIF(PRESENT(PSPSCALAR)) THEN + IF_SCALARS = UBOUND(PSPSCALAR,1) + IF_SCALARS_G = IF_SCALARS +ENDIF + +IF(PRESENT(KVSETSC2)) THEN + IF(.NOT.PRESENT(PSPSC2)) THEN + CALL ABORT_TRANS('INV_TRANS:KVSETSC2 BUT NOT PSPSC2') + ENDIF + IF_SC2_G = UBOUND(KVSETSC2,1) + IF_SCALARS_G = IF_SCALARS_G+UBOUND(KVSETSC2,1) + DO J=1,UBOUND(KVSETSC2,1) + IF(KVSETSC2(J) > NPRTRV .OR. KVSETSC2(J) < 1) THEN + WRITE(NERR,*) 'INV_TRANS:KVSETSC2(J) > NPRTRV ',J,KVSETSC2(J),NPRTRV + CALL ABORT_TRANS('INV_TRANS:KVSETSC2 TOO LONG OR CONTAINS VALUES OUTSIDE RANGE') + ENDIF + IF(KVSETSC2(J) == MYSETV) THEN + IF_SCALARS = IF_SCALARS+1 + NF_SC2 = NF_SC2+1 + ENDIF + ENDDO +ELSEIF(PRESENT(PSPSC2)) THEN + IF_SC2_G = UBOUND(PSPSC2,1) + IF_SCALARS = IF_SCALARS+UBOUND(PSPSC2,1) + IF_SCALARS_G = IF_SCALARS_G +UBOUND(PSPSC2,1) + NF_SC2 = UBOUND(PSPSC2,1) +ENDIF + +IF(PRESENT(KVSETSC3A)) THEN + IF(.NOT.PRESENT(PSPSC3A)) THEN + CALL ABORT_TRANS('INV_TRANS:KVSETSC3A BUT NOT PSPSC3A') + ENDIF + IF_SC3A_G2 = UBOUND(KVSETSC3A,1) + IF_SC3A_G3 = UBOUND(PSPSC3A,3) + IF_SCALARS_G = IF_SCALARS_G+IF_SC3A_G2*IF_SC3A_G3 + DO J=1,UBOUND(KVSETSC3A,1) + IF(KVSETSC3A(J) > NPRTRV .OR. KVSETSC3A(J) < 1) THEN + WRITE(NERR,*) 'INV_TRANS:KVSETSC3A(J) > NPRTRV ',J,KVSETSC3A(J),NPRTRV + CALL ABORT_TRANS& + & ('INV_TRANS:KVSETSC3A TOO LONG OR CONTAINS VALUES OUTSIDE RANGE') + ENDIF + IF(KVSETSC3A(J) == MYSETV) THEN + IF_SCALARS = IF_SCALARS+UBOUND(PSPSC3A,3) + NF_SC3A = NF_SC3A+1 + ENDIF + ENDDO +ELSEIF(PRESENT(PSPSC3A)) THEN + IF_SCALARS = IF_SCALARS+UBOUND(PSPSC3A,1)*UBOUND(PSPSC3A,3) + IF_SC3A_G2 = UBOUND(PSPSC3A,1) + IF_SC3A_G3 = UBOUND(PSPSC3A,3) + IF_SCALARS_G = IF_SCALARS_G + IF_SC3A_G2*IF_SC3A_G3 + NF_SC3A = UBOUND(PSPSC3A,1) +ENDIF + +IF(PRESENT(KVSETSC3B)) THEN + IF(.NOT.PRESENT(PSPSC3B)) THEN + CALL ABORT_TRANS('INV_TRANS:KVSETSC3B BUT NOT PSPSC3B') + ENDIF + IF_SC3B_G2 = UBOUND(KVSETSC3B,1) + IF_SC3B_G3 = UBOUND(PSPSC3B,3) + IF_SCALARS_G = IF_SCALARS_G+IF_SC3B_G2*IF_SC3B_G3 + DO J=1,UBOUND(KVSETSC3B,1) + IF(KVSETSC3B(J) > NPRTRV .OR. KVSETSC3B(J) < 1) THEN + WRITE(NERR,*) 'INV_TRANS:KVSETSC3B(J) > NPRTRV ',J,KVSETSC3B(J),NPRTRV + CALL ABORT_TRANS('INV_TRANS:KVSETSC3B TOO LONG OR CONTAINS VALUES OUTSIDE RANGE') + ENDIF + IF(KVSETSC3B(J) == MYSETV) THEN + IF_SCALARS = IF_SCALARS+UBOUND(PSPSC3B,3) + NF_SC3B = NF_SC3B+1 + ENDIF + ENDDO +ELSEIF(PRESENT(PSPSC3B)) THEN + IF_SCALARS = IF_SCALARS+UBOUND(PSPSC3B,1)*UBOUND(PSPSC3B,3) + IF_SC3B_G2 = UBOUND(PSPSC3B,1) + IF_SC3B_G3 = UBOUND(PSPSC3B,3) + IF_SCALARS_G = IF_SCALARS_G + IF_SC3B_G2*IF_SC3B_G3 + NF_SC3B = UBOUND(PSPSC3B,1) +ENDIF + +IF (IF_SCALARS_G > 0 ) THEN + IF(PRESENT(LDSCDERS)) THEN + LSCDERS = LDSCDERS + IF (LSCDERS) IF_SCDERS = IF_SCALARS + ENDIF +ENDIF + +IF(PRESENT(KPROMA)) THEN + NPROMA = KPROMA +ENDIF + +IF(PRESENT(LDVORGP)) THEN + LVORGP = LDVORGP +ENDIF + +IF(PRESENT(LDDIVGP)) THEN + LDIVGP = LDDIVGP +ENDIF + +IF(PRESENT(LDUVDER)) THEN + LUVDER = LDUVDER +ENDIF + +! Compute derived variables + +IF(LVORGP) LDIVGP = .TRUE. + +NGPBLKS = (D%NGPTOT-1)/NPROMA+1 + +IF_OUT_LT = 2*IF_UV + IF_SCALARS+IF_SCDERS + +IF(IF_UV > 0 .AND. LVORGP) THEN + IF_OUT_LT = IF_OUT_LT+IF_UV +ENDIF +IF(IF_UV > 0 .AND. LDIVGP) THEN + IF_OUT_LT = IF_OUT_LT+IF_UV +ENDIF +IF_FS = IF_OUT_LT+IF_SCDERS +IF(IF_UV > 0 .AND. LUVDER) THEN + IF_FS = IF_FS+2*IF_UV +ENDIF + +IF_GP = 2*IF_UV_G+IF_SCALARS_G +IF(LSCDERS) THEN + IF_GP = IF_GP+2*IF_SCALARS_G + IF_SC2_G = IF_SC2_G*3 + IF_SC3A_G3 = IF_SC3A_G3*3 + IF_SC3B_G3 = IF_SC3B_G3*3 +ENDIF +IF(IF_UV_G > 0 .AND. LVORGP) THEN + IF_GP = IF_GP+IF_UV_G + IF_UV_PAR = IF_UV_PAR+1 +ENDIF +IF(IF_UV_G > 0 .AND. LDIVGP) THEN + IF_GP = IF_GP+IF_UV_G + IF_UV_PAR = IF_UV_PAR+1 +ENDIF +IF(IF_UV_G > 0 .AND. LUVDER) THEN + IF_GP = IF_GP+2*IF_UV_G + IF_UV_PAR = IF_UV_PAR+2 +ENDIF + +! Consistency checks + +IF (IF_UV > 0) THEN + IF(.NOT. PRESENT(PSPVOR) ) THEN + CALL ABORT_TRANS('INV_TRANS : IF_UV > 0 BUT PSPVOR MISSING') + ENDIF + IF(UBOUND(PSPVOR,1) < IF_UV) THEN + WRITE(NERR,*)'INV_TRANS : UBOUND(PSPVOR,1) < IF_UV ',UBOUND(PSPVOR,1),IF_UV + CALL ABORT_TRANS('INV_TRANS : PSPVOR TOO SHORT') + ENDIF + IF(.NOT. PRESENT(PSPDIV) ) THEN + CALL ABORT_TRANS('INV_TRANS : IF_UV > 0 BUT PSPDIV MISSING') + ENDIF + IF(UBOUND(PSPDIV,1) < IF_UV) THEN + WRITE(NERR,*)'INV_TRANS : UBOUND(PSPDIV,1) < IF_UV ',UBOUND(PSPDIV,1),IF_UV + CALL ABORT_TRANS('INV_TRANS : PSPDIV TOO SHORT') + ENDIF +ENDIF + +IF (IF_SCALARS > 0) THEN + IF(PRESENT(PSPSCALAR)) THEN + IF(PRESENT(PSPSC3A))THEN + CALL ABORT_TRANS('INV_TRANS : PSPSCALAR AND PSPSC3A BOTH PRESENT') + ENDIF + IF(PRESENT(PSPSC3B))THEN + CALL ABORT_TRANS('INV_TRANS : PSPSCALAR AND PSPSC3B BOTH PRESENT') + ENDIF + IF(PRESENT(PSPSC2))THEN + CALL ABORT_TRANS('INV_TRANS : PSPSCALAR AND PSPSC2 BOTH PRESENT') + ENDIF + IF(UBOUND(PSPSCALAR,1) < IF_SCALARS) THEN + WRITE(NERR,*)'INV_TRANS : UBOUND(PSPSCALAR,1) < IF_SCALARS) ',& + & UBOUND(PSPSCALAR,1),IF_SCALARS + CALL ABORT_TRANS('INV_TRANS : PSPSCALAR TOO SHORT') + ENDIF + ELSEIF(PRESENT(PSPSC3A)) THEN + ENDIF +ENDIF + +IF(IF_UV_G == 0) THEN + LUVDER = .FALSE. +ENDIF + +IF(NPRTRV >1) THEN + IF(IF_UV > 0 .AND. .NOT. PRESENT(KVSETUV)) THEN + WRITE(NERR,*)'NPRTRV >1 AND IF_UV > 0 AND NOT PRESENT(KVSETUV)',& + & NPRTRV,IF_UV + CALL ABORT_TRANS('INV_TRANS: SPECIFY VERTICAL SPECTRAL DISTRIBUTION!') + ENDIF + IF(PRESENT(PSPSCALAR) .AND. .NOT. PRESENT(KVSETSC)) THEN + WRITE(NERR,*)'NPRTRV >1 AND PRESENT(PSPSCALAR) AND NOT PRESENT(KVSETSC)',& + & NPRTRV + CALL ABORT_TRANS('INV_TRANS: SPECIFY VERTICAL SPECTRAL DISTRIBUTION!') + ENDIF + IF(PRESENT(PSPSC2) .AND. .NOT. PRESENT(KVSETSC2)) THEN + WRITE(NERR,*)'NPRTRV >1 AND PRESENT(PSPSC2) AND NOT PRESENT(KVSETSC2)',& + & NPRTRV + CALL ABORT_TRANS('INV_TRANS: SPECIFY VERTICAL SPECTRAL DISTRIBUTION!') + ENDIF + IF(PRESENT(PSPSC3A) .AND. .NOT. PRESENT(KVSETSC3A)) THEN + WRITE(NERR,*)'NPRTRV >1 AND PRESENT(PSPSC3A) AND NOT PRESENT(KVSETSC3A)',& + & NPRTRV + CALL ABORT_TRANS('INV_TRANS: SPECIFY VERTICAL SPECTRAL DISTRIBUTION!') + ENDIF + IF(PRESENT(PSPSC3B) .AND. .NOT. PRESENT(KVSETSC3B)) THEN + WRITE(NERR,*)'NPRTRV >1 AND PRESENT(PSPSC3B) AND NOT PRESENT(KVSETSC3B)',& + & NPRTRV + CALL ABORT_TRANS('INV_TRANS: SPECIFY VERTICAL SPECTRAL DISTRIBUTION!') + ENDIF +ENDIF + +IF(PRESENT(PGP)) THEN + IF(PRESENT(PGPUV)) THEN + CALL ABORT_TRANS('INV_TRANS:PGP AND PGPUV CAN NOT BOTH BE PRESENT') + ENDIF + IF(PRESENT(PGP3A)) THEN + CALL ABORT_TRANS('INV_TRANS:PGP AND PGP3A CAN NOT BOTH BE PRESENT') + ENDIF + IF(PRESENT(PGP3B)) THEN + CALL ABORT_TRANS('INV_TRANS:PGP AND PGP3B CAN NOT BOTH BE PRESENT') + ENDIF + IF(PRESENT(PGP2)) THEN + CALL ABORT_TRANS('INV_TRANS:PGP AND PGP2 CAN NOT BOTH BE PRESENT') + ENDIF + IUBOUND(1:3)=UBOUND(PGP) + IF(IUBOUND(1) < NPROMA) THEN + WRITE(NOUT,*)'INV_TRANS:FIRST DIM. OF PGP TOO SMALL ',IUBOUND(1),NPROMA + CALL ABORT_TRANS('INV_TRANS:FIRST DIMENSION OF PGP TOO SMALL ') + ENDIF + IF(IUBOUND(2) < IF_GP) THEN + WRITE(NOUT,*)'INV_TRANS:SEC. DIM. OF PGP TOO SMALL ',IUBOUND(2),IF_GP + WRITE(NOUT,*)'IF_UV_G,IF_SCALARS_G,LSCDERS,LVORGP,LDIVGP,LUVDER ',& + & IF_UV_G,IF_SCALARS_G,LSCDERS,LVORGP,LDIVGP,LUVDER + CALL ABORT_TRANS('INV_TRANS:SECOND DIMENSION OF PGP TOO SMALL ') + ENDIF + IF(IUBOUND(3) < NGPBLKS) THEN + WRITE(NOUT,*)'INV_TRANS:THIRD DIM. OF PGP TOO SMALL ',IUBOUND(3),NGPBLKS + CALL ABORT_TRANS('INV_TRANS:THIRD DIMENSION OF PGP TOO SMALL ') + ENDIF +ELSE + IF(NPROMATR > 0 .AND. 2*IF_UV_G+IF_SCALARS_G > NPROMATR) THEN + CALL ABORT_TRANS('INV_TRANS:ALTERNATIVES TO USING PGP NOT SUPPORTED WITH NPROMATR>0') + ENDIF +ENDIF + +IF(PRESENT(PGPUV)) THEN + IF(.NOT.PRESENT(PSPVOR)) THEN + CALL ABORT_TRANS('INV_TRANS:PSPVOR HAS TO BE PRESENT WHEN PGPUV IS') + ENDIF + IUBOUND(1:4)=UBOUND(PGPUV) + IF(IUBOUND(1) < NPROMA) THEN + WRITE(NOUT,*)'INV_TRANS:FIRST DIM. OF PGPUV TOO SMALL ',IUBOUND(1),NPROMA + CALL ABORT_TRANS('INV_TRANS:FIRST DIMENSION OF PGPUV TOO SMALL ') + ENDIF + IF(IUBOUND(2) /= IF_UV_G) THEN + WRITE(NOUT,*)'INV_TRANS:SEC. DIM. OF PGPUV INCONSISTENT ',IUBOUND(2),IF_UV_G + CALL ABORT_TRANS('INV_TRANS:SEC. DIMENSION OF PGPUV INCONSISTENT ') + ENDIF + IF(IUBOUND(3) < IF_UV_PAR) THEN + WRITE(NOUT,*)'INV_TRANS:THIRD DIM. OF PGPUV TOO SMALL ',IUBOUND(3),IF_UV_PAR + CALL ABORT_TRANS('INV_TRANS:THIRD DIMENSION OF PGPUV TOO SMALL ') + ENDIF + IF(IUBOUND(4) < NGPBLKS) THEN + WRITE(NOUT,*)'INV_TRANS:THIRD DIM. OF PGPUV TOO SMALL ',IUBOUND(4),NGPBLKS + CALL ABORT_TRANS('INV_TRANS:THIRD DIMENSION OF PGPUV TOO SMALL ') + ENDIF +ENDIF +IF(PRESENT(PGP2)) THEN + IF(.NOT.PRESENT(PSPSC2)) THEN + CALL ABORT_TRANS('INV_TRANS:PSPSC2 HAS TO BE PRESENT WHEN PGP2 IS') + ENDIF +ENDIF +IF(IF_SC2_G > 0) THEN + IF(PRESENT(PGP2)) THEN + IUBOUND(1:3)=UBOUND(PGP2) + IF(IUBOUND(1) < NPROMA) THEN + WRITE(NOUT,*)'INV_TRANS:FIRST DIM. OF PGP2 TOO SMALL ',IUBOUND(1),NPROMA + CALL ABORT_TRANS('INV_TRANS:FIRST DIMENSION OF PGP2 TOO SMALL ') + ENDIF + IF(IUBOUND(2) /= IF_SC2_G) THEN + WRITE(NOUT,*)'INV_TRANS:SEC. DIM. OF PGP2 INCONSISTENT ',IUBOUND(2),IF_SC2_G + CALL ABORT_TRANS('INV_TRANS:SEC. DIMENSION OF PGP2 INCONSISTENT') + ENDIF + IF(IUBOUND(3) < NGPBLKS) THEN + WRITE(NOUT,*)'INV_TRANS:THIRD DIM. OF PGP2 TOO SMALL ',IUBOUND(3),NGPBLKS + CALL ABORT_TRANS('INV_TRANS:THIRD DIMENSION OF PGP2 TOO SMALL ') + ENDIF + ELSE + CALL ABORT_TRANS('INV_TRANS:PGP2 MISSING') + ENDIF +ENDIF + +IF(PRESENT(PGP3A)) THEN + IF(.NOT.PRESENT(PSPSC3A)) THEN + CALL ABORT_TRANS('INV_TRANS:PSPSC3A HAS TO BE PRESENT WHEN PGP3A IS') + ENDIF +ENDIF +IF(IF_SC3A_G3 > 0) THEN + IF(PRESENT(PGP3A)) THEN + IUBOUND=UBOUND(PGP3A) + IF(IUBOUND(1) < NPROMA) THEN + WRITE(NOUT,*)'INV_TRANS:FIRST DIM. OF PGP3A TOO SMALL ',IUBOUND(1),NPROMA + CALL ABORT_TRANS('INV_TRANS:FIRST DIMENSION OF PGP3A TOO SMALL ') + ENDIF + IF(IUBOUND(2) /= IF_SC3A_G2) THEN + WRITE(NOUT,*)'INV_TRANS:SEC DIM. OF PGP3A INCONSISTENT ',IUBOUND(2),IF_SC3A_G2 + CALL ABORT_TRANS('INV_TRANS:SEC. DIMENSION OF PGP3A INCONSISTENT ') + ENDIF + IF(IUBOUND(3) /= IF_SC3A_G3 ) THEN + WRITE(NOUT,*)'INV_TRANS:THIRD DIM. OF PGP3A INCONSISTENT ',& + & IUBOUND(3),IF_SC3A_G3 + CALL ABORT_TRANS('INV_TRANS:THIRD DIMENSION OF PGP3A INCONSISTENT ') + ENDIF + IF(IUBOUND(4) < NGPBLKS) THEN + WRITE(NOUT,*)'INV_TRANS:FOURTH DIM. OF PGP3A TOO SMALL ',IUBOUND(4),NGPBLKS + CALL ABORT_TRANS('INV_TRANS:FOURTH DIMENSION OF PGP3A TOO SMALL ') + ENDIF + ELSE + CALL ABORT_TRANS('INV_TRANS:PGP3A MISSING') + ENDIF +ENDIF + +IF(PRESENT(PGP3B)) THEN + IF(.NOT.PRESENT(PSPSC3B)) THEN + CALL ABORT_TRANS('INV_TRANS:PSPSC3B HAS TO BE PRESENT WHEN PGP3B IS') + ENDIF +ENDIF +IF(IF_SC3B_G3 > 0) THEN + IF(PRESENT(PGP3B)) THEN + IUBOUND=UBOUND(PGP3B) + IF(IUBOUND(1) < NPROMA) THEN + WRITE(NOUT,*)'INV_TRANS:FIRST DIM. OF PGP3B TOO SMALL ',IUBOUND(1),NPROMA + CALL ABORT_TRANS('INV_TRANS:FIRST DIMENSION OF PGP3B TOO SMALL ') + ENDIF + IF(IUBOUND(2) /= IF_SC3B_G2) THEN + WRITE(NOUT,*)'INV_TRANS:SEC DIM. OF PGP3B INCONSISTENT ',IUBOUND(2),IF_SC3B_G2 + CALL ABORT_TRANS('INV_TRANS:SEC. DIMENSION OF PGP3B INCONSISTENT ') + ENDIF + IF(IUBOUND(3) /= IF_SC3B_G3 ) THEN + WRITE(NOUT,*)'INV_TRANS:THIRD DIM. OF PGP3B INCONSISTENT ',& + & IUBOUND(3),IF_SC3B_G3 + CALL ABORT_TRANS('INV_TRANS:THIRD DIMENSION OF PGP3B INCONSISTENT ') + ENDIF + IF(IUBOUND(4) < NGPBLKS) THEN + WRITE(NOUT,*)'INV_TRANS:FOURTH DIM. OF PGP3B TOO SMALL ',IUBOUND(4),NGPBLKS + CALL ABORT_TRANS('INV_TRANS:FOURTH DIMENSION OF PGP3B TOO SMALL ') + ENDIF + ELSE + CALL ABORT_TRANS('INV_TRANS:PGP3B MISSING') + ENDIF +ENDIF +CALL GSTATS(1807,1) + +! ------------------------------------------------------------------ + +! Perform transform +CALL EINV_TRANS_CTL(IF_UV_G,IF_SCALARS_G,IF_GP,IF_FS,IF_OUT_LT,& + & IF_UV,IF_SCALARS,IF_SCDERS,& + & PSPVOR,PSPDIV,PSPSCALAR,KVSETUV,KVSETSC,PGP,FSPGL_PROC,& + & PSPSC3A,PSPSC3B,PSPSC2,KVSETSC3A,KVSETSC3B,KVSETSC2,PGPUV,PGP3A,PGP3B,PGP2,& + & PMEANU,PMEANV ) +IF (LHOOK) CALL DR_HOOK('EINV_TRANS',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +!endif INTERFACE + +END SUBROUTINE EINV_TRANS + diff --git a/src/etrans/etrans/external/einv_transad.F90 b/src/etrans/etrans/external/einv_transad.F90 new file mode 100644 index 000000000..0f38dd37e --- /dev/null +++ b/src/etrans/etrans/external/einv_transad.F90 @@ -0,0 +1,609 @@ +SUBROUTINE EINV_TRANSAD(PSPVOR,PSPDIV,PSPSCALAR,PSPSC3A,PSPSC3B,PSPSC2,& + & FSPGL_PROC,& + & LDSCDERS,LDVORGP,LDDIVGP,LDUVDER,KPROMA,KVSETUV,KVSETSC,KRESOL,& + & KVSETSC3A,KVSETSC3B,KVSETSC2,& + & PGP,PGPUV,PGP3A,PGP3B,PGP2,PMEANU,PMEANV) + +!**** *EINV_TRANSAD* - Inverse spectral transform - adjoint. + +! Purpose. +! -------- +! Interface routine for the inverse spectral transform - adjoint + +!** Interface. +! ---------- +! CALL EINV_TRANSAD(...) + +! Explicit arguments : All arguments except from PGP are optional. +! -------------------- +! PSPVOR(:,:) - spectral vorticity (input) +! PSPDIV(:,:) - spectral divergence (input) +! PSPSCALAR(:,:) - spectral scalarvalued fields (input) +! PSPSC3A(:,:,:) - alternative to use of PSPSCALAR, see PGP3A below (input) +! PSPSC3B(:,:,:) - alternative to use of PSPSCALAR, see PGP3B below (input) +! PSPSC2(:,:) - alternative to use of PSPSCALAR, see PGP2 below (input) +! FSPGL_PROC - external procedure to be executed in fourier space +! before transposition +! LDSCDERS - indicating if derivatives of scalar variables are req. +! LDVORGP - indicating if grid-point vorticity is req. +! LDDIVGP - indicating if grid-point divergence is req. +! LDUVDER - indicating if E-W derivatives of u and v are req. +! KPROMA - required blocking factor for gridpoint output +! KVSETUV(:) - indicating which 'b-set' in spectral space owns a +! vor/div field. Equivalant to NBSETLEV in the IFS. +! The length of KVSETUV should be the GLOBAL number +! of u/v fields which is the dimension of u and v releated +! fields in grid-point space. +! KVESETSC(:) - indicating which 'b-set' in spectral space owns a +! scalar field. As for KVSETUV this argument is required +! if the total number of processors is greater than +! the number of processors used for distribution in +! spectral wave space. +! KVSETSC3A(:) - as KVESETSC for PSPSC3A (distribution on first dimension) +! KVSETSC3B(:) - as KVESETSC for PSPSC3B (distribution on first dimension) +! KVSETSC2(:) - as KVESETSC for PSPSC2 (distribution on first dimension) +! KRESOL - resolution tag which is required ,default is the +! first defined resulution (input) +! PGP(:,:,:) - gridpoint fields (output) +! PGP need to dimensioned (NPROMA,IF_GP,NGPBLKS) where +! NPROMA is the blocking factor, IF_GP the total number +! of output fields and NGPBLKS the number of NPROMA blocks. +! The ordering of the output fields is as follows (all +! parts are optional depending on the input switches): + +! vorticity : IF_UV_G fields (if psvor present and LDVORGP) +! divergence : IF_UV_G fields (if psvor present and LDDIVGP) +! u : IF_UV_G fields (if psvor present) +! v : IF_UV_G fields (if psvor present) +! scalar fields : IF_SCALARS_G fields (if pspscalar present) +! N-S derivative of scalar fields : IF_SCALARS_G fields (if pspscalar +! present and LDSCDERS) +! E-W derivative of u : IF_UV_G fields (if psvor present and and LDUVDER) +! E-W derivative of v : IF_UV_G fields (if psvor present and and LDUVDER) +! E-W derivative of scalar fields : IF_SCALARS_G fields (if pspscalar +! present and LDSCDERS) + +! Here IF_UV_G is the GLOBAL number of u/v fields as given by the length +! of KVSETUV (or by PSPVOR if no split in spectral 'b-set' direction +! IF_SCALARS_G is the GLOBAL number of scalar fields as giben by the +! length of KVESETSC (or by number of fields in PSPSCALAR if no spectral +! 'b-set' split + +! As an alternative to using PGP you can also use a combination of the +! following arrays. The reason for introducing these alternative ways +! of calling INV_TRANS is to avoid uneccessary copies where your data +! structures don't fit in to the 'PSPVOR,PSPDIV, PSPSCALAR, PGP' layout. +! The use of any of these precludes the use of PGP and vice versa. + +! PGPUV(:,:,:,:) - the 'u-v' related grid-point variables in the order +! described for PGP. The second dimension of PGPUV should +! be the same as the "global" first dimension of +! PSPVOR,PSPDIV (in the IFS this is the number of levels) +! PGPUV need to be dimensioned(NPROMA,ILEVS,IFLDS,NGPBLKS) +! IFLDS is the number of 'variables' (u,v,vor,div ...) +! PGP3A(:,:,:,:) - grid-point array directly connected with PSPSC3A +! dimensioned(NPROMA,ILEVS,IFLDS,NGPBLKS) +! IFLDS is the number of 'variables' (the same as in +! PSPSC3A if no derivatives, 3 times that with der.) +! PGP3B(:,:,:,:) - grid-point array directly connected with PSPSC3B +! dimensioned(NPROMA,ILEVS,IFLDS,NGPBLKS) +! IFLDS is the number of 'variables' (the same as in +! PSPSC3B if no derivatives, 3 times that with der.) +! PGP2(:,:,:) - grid-point array directly connected with PSPSC2 +! dimensioned(NPROMA,IFLDS,NGPBLKS) +! IFLDS is the number of 'variables' (the same as in +! PSPSC2 if no derivatives, 3 times that with der.) + +! Method. +! ------- + +! Externals. ESET_RESOL - set resolution +! ---------- ELTDIR_CTLAD - control of Legendre transform +! EFTDIR_CTLAD - control of Fourier transform + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-03-03 +! G. Radnoti: like in direct code: IF_SCALARS_G fields (if pspscalar +! present and LDSCDERS) +! M.Hamrud 01-Oct-2003 CY28 Cleaning + +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +!ifndef INTERFACE + +USE TPM_GEN ,ONLY : NERR, NOUT, NPROMATR +!USE TPM_DIM +USE TPM_TRANS ,ONLY : LDIVGP, LSCDERS, LUVDER, LVORGP, & + & NF_SC2, NF_SC3A, NF_SC3B, NGPBLKS, NPROMA +USE TPM_DISTR ,ONLY : D, NPRTRV, MYSETV +!USE TPM_GEOMETRY +!USE TPM_FIELDS +!USE TPM_FFT + +USE ESET_RESOL_MOD ,ONLY : ESET_RESOL +USE EINV_TRANS_CTLAD_MOD ,ONLY : EINV_TRANS_CTLAD +USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS + +!endif INTERFACE + +IMPLICIT NONE + +! Declaration of arguments + +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PSPVOR(:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PSPDIV(:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PSPSCALAR(:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PSPSC3A(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PSPSC3B(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PSPSC2(:,:) +LOGICAL ,OPTIONAL,INTENT(IN) :: LDSCDERS +LOGICAL ,OPTIONAL,INTENT(IN) :: LDVORGP +LOGICAL ,OPTIONAL,INTENT(IN) :: LDDIVGP +LOGICAL ,OPTIONAL,INTENT(IN) :: LDUVDER +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KPROMA +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KVSETUV(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KVSETSC(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KRESOL +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KVSETSC3A(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KVSETSC3B(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KVSETSC2(:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PGP(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PGPUV(:,:,:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PGP3A(:,:,:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PGP3B(:,:,:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PGP2(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PMEANU(:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PMEANV(:) +EXTERNAL FSPGL_PROC +OPTIONAL FSPGL_PROC +!ifndef INTERFACE + +! Local varaibles +INTEGER(KIND=JPIM) :: IUBOUND(4),J +INTEGER(KIND=JPIM) :: IF_UV,IF_UV_G,IF_SCALARS,IF_SCALARS_G,IF_FS,IF_GP,IF_OUT_LT +INTEGER(KIND=JPIM) :: IF_SCDERS,IF_UV_PAR +INTEGER(KIND=JPIM) :: IF_SC2_G,IF_SC3A_G2,IF_SC3A_G3,IF_SC3B_G2,IF_SC3B_G3 +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE +! ------------------------------------------------------------------ + +IF (LHOOK) CALL DR_HOOK('EINV_TRANSAD',0,ZHOOK_HANDLE) +CALL GSTATS(1809,0) + +! Set current resolution +CALL ESET_RESOL(KRESOL) + +! Set defaults + +LVORGP = .FALSE. +LDIVGP = .FALSE. +LUVDER = .FALSE. +IF_UV = 0 +IF_UV_G = 0 +IF_UV_PAR = 0 +IF_SCALARS = 0 +IF_SCALARS_G = 0 +IF_SCDERS = 0 +NF_SC2 = 0 +NF_SC3A = 0 +NF_SC3B = 0 +IF_SC2_G = 0 +IF_SC3A_G2 = 0 +IF_SC3B_G2 = 0 +IF_SC3A_G3 = 0 +IF_SC3B_G3 = 0 +NPROMA = D%NGPTOT +LSCDERS = .FALSE. + +! Decide requirements + +IF(PRESENT(KVSETUV)) THEN + IF_UV_G = UBOUND(KVSETUV,1) + IF_UV_PAR = 2 + DO J=1,IF_UV_G + IF(KVSETUV(J) > NPRTRV .OR. KVSETUV(J) < 1) THEN + WRITE(NERR,*) 'EINV_TRANSAD:KVSETUV(J) > NPRTRV ',J,KVSETUV(J),NPRTRV + CALL ABORT_TRANS('EINV_TRANSAD:KVSETUV TOO LONG OR CONTAINS VALUES OUTSIDE RANGE') + ENDIF + IF(KVSETUV(J) == MYSETV) THEN + IF_UV = IF_UV+1 + ENDIF + ENDDO +ELSEIF(PRESENT(PSPVOR)) THEN + IF_UV = UBOUND(PSPVOR,1) + IF_UV_G = IF_UV + IF_UV_PAR = 2 +ENDIF + +IF(PRESENT(KVSETSC)) THEN + IF_SCALARS_G = UBOUND(KVSETSC,1) + DO J=1,IF_SCALARS_G + IF(KVSETSC(J) > NPRTRV .OR. KVSETSC(J) < 1) THEN + WRITE(NERR,*) 'EINV_TRANSAD:KVSETSC(J) > NPRTRV ',J,KVSETSC(J),NPRTRV + CALL ABORT_TRANS('EINV_TRANSAD:KVSETSC TOO LONG OR CONTAINS VALUES OUTSIDE RANGE') + ENDIF + IF(KVSETSC(J) == MYSETV) THEN + IF_SCALARS = IF_SCALARS+1 + ENDIF + ENDDO +ELSEIF(PRESENT(PSPSCALAR)) THEN + IF_SCALARS = UBOUND(PSPSCALAR,1) + IF_SCALARS_G = IF_SCALARS +ENDIF + +IF(PRESENT(KVSETSC2)) THEN + IF(.NOT.PRESENT(PSPSC2)) THEN + CALL ABORT_TRANS('EINV_TRANSAD:KVSETSC2 BUT NOT PSPSC2') + ENDIF + IF_SC2_G = UBOUND(KVSETSC2,1) + IF_SCALARS_G = IF_SCALARS_G+UBOUND(KVSETSC2,1) + DO J=1,UBOUND(KVSETSC2,1) + IF(KVSETSC2(J) > NPRTRV .OR. KVSETSC2(J) < 1) THEN + WRITE(NERR,*) 'EINV_TRANSAD:KVSETSC2(J) > NPRTRV ',J,KVSETSC2(J),NPRTRV + CALL ABORT_TRANS('EINV_TRANSAD:KVSETSC2 TOO LONG OR CONTAINS VALUES OUTSIDE RANGE') + ENDIF + IF(KVSETSC2(J) == MYSETV) THEN + IF_SCALARS = IF_SCALARS+1 + NF_SC2 = NF_SC2+1 + ENDIF + ENDDO +ELSEIF(PRESENT(PSPSC2)) THEN + IF_SC2_G = UBOUND(PSPSC2,1) + IF_SCALARS = IF_SCALARS+UBOUND(PSPSC2,1) + IF_SCALARS_G = IF_SCALARS_G +UBOUND(PSPSC2,1) + NF_SC2 = UBOUND(PSPSC2,1) +ENDIF + +IF(PRESENT(KVSETSC3A)) THEN + IF(.NOT.PRESENT(PSPSC3A)) THEN + CALL ABORT_TRANS('EINV_TRANSAD:KVSETSC3A BUT NOT PSPSC3A') + ENDIF + IF_SC3A_G2 = UBOUND(KVSETSC3A,1) + IF_SC3A_G3 = UBOUND(PSPSC3A,3) + IF_SCALARS_G = IF_SCALARS_G+IF_SC3A_G2*IF_SC3A_G3 + DO J=1,UBOUND(KVSETSC3A,1) + IF(KVSETSC3A(J) > NPRTRV .OR. KVSETSC3A(J) < 1) THEN + WRITE(NERR,*) 'EINV_TRANSAD:KVSETSC3A(J) > NPRTRV ',J,KVSETSC3A(J),NPRTRV + CALL ABORT_TRANS& + & ('INV_TRANSAD:KVSETSC3A TOO LONG OR CONTAINS VALUES OUTSIDE RANGE') + ENDIF + IF(KVSETSC3A(J) == MYSETV) THEN + IF_SCALARS = IF_SCALARS+UBOUND(PSPSC3A,3) + NF_SC3A = NF_SC3A+1 + ENDIF + ENDDO +ELSEIF(PRESENT(PSPSC3A)) THEN + IF_SCALARS = IF_SCALARS+UBOUND(PSPSC3A,1)*UBOUND(PSPSC3A,3) + IF_SC3A_G2 = UBOUND(PSPSC3A,1) + IF_SC3A_G3 = UBOUND(PSPSC3A,3) + IF_SCALARS_G = IF_SCALARS_G + IF_SC3A_G2*IF_SC3A_G3 + NF_SC3A = UBOUND(PSPSC3A,1) +ENDIF + +IF(PRESENT(KVSETSC3B)) THEN + IF(.NOT.PRESENT(PSPSC3B)) THEN + CALL ABORT_TRANS('EINV_TRANSAD:KVSETSC3B BUT NOT PSPSC3B') + ENDIF + IF_SC3B_G2 = UBOUND(KVSETSC3B,1) + IF_SC3B_G3 = UBOUND(PSPSC3B,3) + IF_SCALARS_G = IF_SCALARS_G+IF_SC3B_G2*IF_SC3B_G3 + DO J=1,UBOUND(KVSETSC3B,1) + IF(KVSETSC3B(J) > NPRTRV .OR. KVSETSC3B(J) < 1) THEN + WRITE(NERR,*) 'EINV_TRANSAD:KVSETSC3B(J) > NPRTRV ',J,KVSETSC3B(J),NPRTRV + CALL ABORT_TRANS('EINV_TRANSAD:KVSETSC3B TOO LONG OR CONTAINS VALUES OUTSIDE RANGE') + ENDIF + IF(KVSETSC3B(J) == MYSETV) THEN + IF_SCALARS = IF_SCALARS+UBOUND(PSPSC3B,3) + NF_SC3B = NF_SC3B+1 + ENDIF + ENDDO +ELSEIF(PRESENT(PSPSC3B)) THEN + IF_SCALARS = IF_SCALARS+UBOUND(PSPSC3B,1)*UBOUND(PSPSC3B,3) + IF_SC3B_G2 = UBOUND(PSPSC3B,1) + IF_SC3B_G3 = UBOUND(PSPSC3B,3) + IF_SCALARS_G = IF_SCALARS_G + IF_SC3B_G2*IF_SC3B_G3 + NF_SC3B = UBOUND(PSPSC3B,1) +ENDIF + +IF (IF_SCALARS > 0) THEN + IF(PRESENT(LDSCDERS)) THEN + LSCDERS = LDSCDERS + IF (LSCDERS) IF_SCDERS = IF_SCALARS + ENDIF +ENDIF + +IF(PRESENT(KPROMA)) THEN + NPROMA = KPROMA +ENDIF + +IF(PRESENT(LDVORGP)) THEN + LVORGP = LDVORGP +ENDIF + +IF(PRESENT(LDDIVGP)) THEN + LDIVGP = LDDIVGP +ENDIF + +IF(PRESENT(LDUVDER)) THEN + LUVDER = LDUVDER +ENDIF + +! Compute derived variables + +IF(LVORGP) LDIVGP = .TRUE. + +NGPBLKS = (D%NGPTOT-1)/NPROMA+1 + +IF_OUT_LT = 2*IF_UV + IF_SCALARS+IF_SCDERS + +IF(IF_UV > 0 .AND. LVORGP) THEN + IF_OUT_LT = IF_OUT_LT+IF_UV +ENDIF +IF(IF_UV > 0 .AND. LDIVGP) THEN + IF_OUT_LT = IF_OUT_LT+IF_UV +ENDIF +IF_FS = IF_OUT_LT+IF_SCDERS +IF(IF_UV > 0 .AND. LUVDER) THEN + IF_FS = IF_FS+2*IF_UV +ENDIF + +IF_GP = 2*IF_UV_G+IF_SCALARS_G +IF(LSCDERS) THEN + IF_GP = IF_GP+2*IF_SCALARS_G + IF_SC2_G = IF_SC2_G*3 + IF_SC3A_G3 = IF_SC3A_G3*3 + IF_SC3B_G3 = IF_SC3B_G3*3 +ENDIF +IF(IF_UV_G > 0 .AND. LVORGP) THEN + IF_GP = IF_GP+IF_UV_G + IF_UV_PAR = IF_UV_PAR+1 +ENDIF +IF(IF_UV_G > 0 .AND. LDIVGP) THEN + IF_GP = IF_GP+IF_UV_G + IF_UV_PAR = IF_UV_PAR+1 +ENDIF +IF(IF_UV_G > 0 .AND. LUVDER) THEN + IF_GP = IF_GP+2*IF_UV_G + IF_UV_PAR = IF_UV_PAR+2 +ENDIF + +! Consistency checks + +IF (IF_UV > 0) THEN + IF(.NOT. PRESENT(PSPVOR) ) THEN + CALL ABORT_TRANS("EINV_TRANSAD : IF_UV > 0 BUT PSPVOR MISSING") + ENDIF + IF(UBOUND(PSPVOR,1) < IF_UV) THEN + WRITE(NERR,*)'EINV_TRANSAD : UBOUND(PSPVOR,1) < IF_UV ',& + & UBOUND(PSPVOR,1),IF_UV + CALL ABORT_TRANS("EINV_TRANSAD : PSPVOR TOO SHORT") + ENDIF + IF(.NOT. PRESENT(PSPDIV) ) THEN + CALL ABORT_TRANS("EINV_TRANSAD : IF_UV > 0 BUT PSPDIV MISSING") + ENDIF + IF(UBOUND(PSPDIV,1) < IF_UV) THEN + WRITE(NERR,*)'INV_TRANSAD : UBOUND(PSPDIV,1) < IF_UV ',& + & UBOUND(PSPDIV,1),IF_UV + CALL ABORT_TRANS("EINV_TRANSAD : PSPDIV TOO SHORT") + ENDIF +ENDIF + +IF (IF_SCALARS > 0) THEN + IF(PRESENT(PSPSCALAR)) THEN + IF(PRESENT(PSPSC3A))THEN + CALL ABORT_TRANS('EINV_TRANS : PSPSCALAR AND PSPSC3A BOTH PRESENT') + ENDIF + IF(PRESENT(PSPSC3B))THEN + CALL ABORT_TRANS('EINV_TRANS : PSPSCALAR AND PSPSC3B BOTH PRESENT') + ENDIF + IF(PRESENT(PSPSC2))THEN + CALL ABORT_TRANS('EINV_TRANS : PSPSCALAR AND PSPSC2 BOTH PRESENT') + ENDIF + IF(UBOUND(PSPSCALAR,1) < IF_SCALARS) THEN + WRITE(NERR,*)'EINV_TRANS : UBOUND(PSPSCALAR,1) < IF_SCALARS) ',& + & UBOUND(PSPSCALAR,1),IF_SCALARS + CALL ABORT_TRANS('EINV_TRANS : PSPSCALAR TOO SHORT') + ENDIF + ELSEIF(PRESENT(PSPSC3A)) THEN + ENDIF +ENDIF + +IF(IF_UV_G == 0) THEN + LUVDER = .FALSE. +ENDIF + +IF(NPRTRV >1) THEN + IF(IF_UV > 0 .AND. .NOT. PRESENT(KVSETUV)) THEN + WRITE(NERR,*)'NPRTRV >1 AND IF_UV > 0 AND NOT PRESENT(KVSETUV)',& + & NPRTRV,IF_UV + CALL ABORT_TRANS('EINV_TRANSAD: SPECIFY VERTICAL SPECTRAL DISTRIBUTION!') + ENDIF + IF(PRESENT(PSPSCALAR) .AND. .NOT. PRESENT(KVSETSC)) THEN + WRITE(NERR,*)'NPRTRV >1 AND PRESENT(PSPSCALAR) AND NOT PRESENT(KVSETSC)',& + & NPRTRV + CALL ABORT_TRANS('EINV_TRANSAD: SPECIFY VERTICAL SPECTRAL DISTRIBUTION!') + ENDIF + IF(PRESENT(PSPSC2) .AND. .NOT. PRESENT(KVSETSC2)) THEN + WRITE(NERR,*)'NPRTRV >1 AND PRESENT(PSPSC2) AND NOT PRESENT(KVSETSC2)',& + & NPRTRV + CALL ABORT_TRANS('EINV_TRANSAD: SPECIFY VERTICAL SPECTRAL DISTRIBUTION!') + ENDIF + IF(PRESENT(PSPSC3A) .AND. .NOT. PRESENT(KVSETSC3A)) THEN + WRITE(NERR,*)'NPRTRV >1 AND PRESENT(PSPSC3A) AND NOT PRESENT(KVSETSC3A)',& + & NPRTRV + CALL ABORT_TRANS('EINV_TRANSAD: SPECIFY VERTICAL SPECTRAL DISTRIBUTION!') + ENDIF + IF(PRESENT(PSPSC3B) .AND. .NOT. PRESENT(KVSETSC3B)) THEN + WRITE(NERR,*)'NPRTRV >1 AND PRESENT(PSPSC3B) AND NOT PRESENT(KVSETSC3B)',& + & NPRTRV + CALL ABORT_TRANS('EINV_TRANSAD: SPECIFY VERTICAL SPECTRAL DISTRIBUTION!') + ENDIF +ENDIF + +IF(PRESENT(PGP)) THEN + IF(PRESENT(PGPUV)) THEN + CALL ABORT_TRANS('EINV_TRANSAD:PGP AND PGPUV CAN NOT BOTH BE PRESENT') + ENDIF + IF(PRESENT(PGP3A)) THEN + CALL ABORT_TRANS('EINV_TRANSAD:PGP AND PGP3A CAN NOT BOTH BE PRESENT') + ENDIF + IF(PRESENT(PGP3B)) THEN + CALL ABORT_TRANS('EINV_TRANSAD:PGP AND PGP3B CAN NOT BOTH BE PRESENT') + ENDIF + IF(PRESENT(PGP2)) THEN + CALL ABORT_TRANS('EINV_TRANSAD:PGP AND PGP2 CAN NOT BOTH BE PRESENT') + ENDIF + IUBOUND(1:3)=UBOUND(PGP) + IF(IUBOUND(1) < NPROMA) THEN + WRITE(NOUT,*)'EINV_TRANSAD:FIRST DIM. OF PGP TOO SMALL ',IUBOUND(1),NPROMA + CALL ABORT_TRANS('EINV_TRANSAD:FIRST DIMENSION OF PGP TOO SMALL ') + ENDIF + IF(IUBOUND(2) < IF_GP) THEN + WRITE(NOUT,*)'EINV_TRANSAD:SEC. DIM. OF PGP TOO SMALL ',IUBOUND(2),IF_GP + WRITE(NOUT,*)'IF_UV_G,IF_SCALARS_G,LSCDERS,LVORGP,LDIVGP,LUVDER ',& + & IF_UV_G,IF_SCALARS_G,LSCDERS,LVORGP,LDIVGP,LUVDER + CALL ABORT_TRANS('EINV_TRANSAD:SECOND DIMENSION OF PGP TOO SMALL ') + ENDIF + IF(IUBOUND(3) < NGPBLKS) THEN + WRITE(NOUT,*)'INV_TRANSAD:THIRD DIM. OF PGP TOO SMALL ',IUBOUND(3),NGPBLKS + CALL ABORT_TRANS('EINV_TRANSAD:THIRD DIMENSION OF PGP TOO SMALL ') + ENDIF +ELSE + IF(NPROMATR > 0 .AND. 2*IF_UV_G+IF_SCALARS_G > NPROMATR) THEN + CALL ABORT_TRANS('EINV_TRANSAD:ALTERNATIVES TO USING PGP NOT SUPPORTED WITH NPROMATR>0') + ENDIF +ENDIF + +IF(PRESENT(PGPUV)) THEN + IF(.NOT.PRESENT(PSPVOR)) THEN + CALL ABORT_TRANS('EINV_TRANSAD:PSPVOR HAS TO BE PRESENT WHEN PGPUV IS') + ENDIF + IUBOUND(1:4)=UBOUND(PGPUV) + IF(IUBOUND(1) < NPROMA) THEN + WRITE(NOUT,*)'EINV_TRANSAD:FIRST DIM. OF PGPUV TOO SMALL ',IUBOUND(1),NPROMA + CALL ABORT_TRANS('EINV_TRANSAD:FIRST DIMENSION OF PGPUV TOO SMALL ') + ENDIF + IF(IUBOUND(2) /= IF_UV_G) THEN + WRITE(NOUT,*)'EINV_TRANSAD:SEC. DIM. OF PGPUV INCONSISTENT ',IUBOUND(2),IF_UV_G + CALL ABORT_TRANS('EINV_TRANSAD:SEC. DIMENSION OF PGPUV INCONSISTENT ') + ENDIF + IF(IUBOUND(3) < IF_UV_PAR) THEN + WRITE(NOUT,*)'EINV_TRANSAD:THIRD DIM. OF PGPUV TOO SMALL ',IUBOUND(3),IF_UV_PAR + CALL ABORT_TRANS('EINV_TRANSAD:THIRD DIMENSION OF PGPUV TOO SMALL ') + ENDIF + IF(IUBOUND(4) < NGPBLKS) THEN + WRITE(NOUT,*)'EINV_TRANSAD:THIRD DIM. OF PGPUV TOO SMALL ',IUBOUND(4),NGPBLKS + CALL ABORT_TRANS('EINV_TRANSAD:THIRD DIMENSION OF PGPUV TOO SMALL ') + ENDIF +ENDIF + +IF(PRESENT(PGP2)) THEN + IF(.NOT.PRESENT(PSPSC2)) THEN + CALL ABORT_TRANS('EINV_TRANSAD:PSPSC2 HAS TO BE PRESENT WHEN PGP2 IS') + ENDIF +ENDIF +IF(IF_SC2_G > 0) THEN + IF(PRESENT(PGP2)) THEN + IUBOUND(1:3)=UBOUND(PGP2) + IF(IUBOUND(1) < NPROMA) THEN + WRITE(NOUT,*)'INV_TRANSAD:FIRST DIM. OF PGP2 TOO SMALL ',IUBOUND(1),NPROMA + CALL ABORT_TRANS('INV_TRANSAD:FIRST DIMENSION OF PGP2 TOO SMALL ') + ENDIF + IF(IUBOUND(2) /= IF_SC2_G) THEN + WRITE(NOUT,*)'EINV_TRANSAD:SEC. DIM. OF PGP2 INCONSISTENT ',IUBOUND(2),IF_SC2_G + CALL ABORT_TRANS('EINV_TRANSAD:SEC. DIMENSION OF PGP2 INCONSISTENT') + ENDIF + IF(IUBOUND(3) < NGPBLKS) THEN + WRITE(NOUT,*)'EINV_TRANSAD:THIRD DIM. OF PGP2 TOO SMALL ',IUBOUND(3),NGPBLKS + CALL ABORT_TRANS('EINV_TRANSAD:THIRD DIMENSION OF PGP2 TOO SMALL ') + ENDIF + ELSE + CALL ABORT_TRANS('EINV_TRANSAD:PGP2 MISSING') + ENDIF +ENDIF + +IF(PRESENT(PGP3A)) THEN + IF(.NOT.PRESENT(PSPSC3A)) THEN + CALL ABORT_TRANS('EINV_TRANSAD:PSPSC3A HAS TO BE PRESENT WHEN PGP3A IS') + ENDIF +ENDIF +IF(IF_SC3A_G3 > 0) THEN + IF(PRESENT(PGP3A)) THEN + IUBOUND=UBOUND(PGP3A) + IF(IUBOUND(1) < NPROMA) THEN + WRITE(NOUT,*)'EINV_TRANSAD:FIRST DIM. OF PGP3A TOO SMALL ',IUBOUND(1),NPROMA + CALL ABORT_TRANS('EINV_TRANSAD:FIRST DIMENSION OF PGP3A TOO SMALL ') + ENDIF + IF(IUBOUND(2) /= IF_SC3A_G2) THEN + WRITE(NOUT,*)'EINV_TRANSAD:SEC DIM. OF PGP3A INCONSISTENT ',IUBOUND(2),IF_SC3A_G2 + CALL ABORT_TRANS('EINV_TRANSAD:SEC. DIMENSION OF PGP3A INCONSISTENT ') + ENDIF + IF(IUBOUND(3) /= IF_SC3A_G3 ) THEN + WRITE(NOUT,*)'EINV_TRANSAD:THIRD DIM. OF PGP3A INCONSISTENT ',& + & IUBOUND(3),IF_SC3A_G3 + CALL ABORT_TRANS('EINV_TRANSAD:THIRD DIMENSION OF PGP3A INCONSISTENT ') + ENDIF + IF(IUBOUND(4) < NGPBLKS) THEN + WRITE(NOUT,*)'EINV_TRANSAD:FOURTH DIM. OF PGP3A TOO SMALL ',IUBOUND(4),NGPBLKS + CALL ABORT_TRANS('EINV_TRANSAD:FOURTH DIMENSION OF PGP3A TOO SMALL ') + ENDIF + ELSE + CALL ABORT_TRANS('EINV_TRANSAD:PGP3A MISSING') + ENDIF +ENDIF + +IF(PRESENT(PGP3B)) THEN + IF(.NOT.PRESENT(PSPSC3B)) THEN + CALL ABORT_TRANS('EINV_TRANSAD:PSPSC3B HAS TO BE PRESENT WHEN PGP3B IS') + ENDIF +ENDIF +IF(IF_SC3B_G3 > 0) THEN + IF(PRESENT(PGP3B)) THEN + IUBOUND=UBOUND(PGP3B) + IF(IUBOUND(1) < NPROMA) THEN + WRITE(NOUT,*)'EINV_TRANSAD:FIRST DIM. OF PGP3B TOO SMALL ',IUBOUND(1),NPROMA + CALL ABORT_TRANS('EINV_TRANSAD:FIRST DIMENSION OF PGP3B TOO SMALL ') + ENDIF + IF(IUBOUND(2) /= IF_SC3B_G2) THEN + WRITE(NOUT,*)'EINV_TRANSAD:SEC DIM. OF PGP3B INCONSISTENT ',IUBOUND(2),IF_SC3B_G2 + CALL ABORT_TRANS('EINV_TRANSAD:SEC. DIMENSION OF PGP3B INCONSISTENT ') + ENDIF + IF(IUBOUND(3) /= IF_SC3B_G3 ) THEN + WRITE(NOUT,*)'EINV_TRANSAD:THIRD DIM. OF PGP3B INCONSISTENT ',& + & IUBOUND(3),IF_SC3B_G3 + CALL ABORT_TRANS('EINV_TRANSAD:THIRD DIMENSION OF PGP3B INCONSISTENT ') + ENDIF + IF(IUBOUND(4) < NGPBLKS) THEN + WRITE(NOUT,*)'EINV_TRANSAD:FOURTH DIM. OF PGP3B TOO SMALL ',IUBOUND(4),NGPBLKS + CALL ABORT_TRANS('EINV_TRANSAD:FOURTH DIMENSION OF PGP3B TOO SMALL ') + ENDIF + ELSE + CALL ABORT_TRANS('EINV_TRANSAD:PGP3B MISSING') + ENDIF +ENDIF +CALL GSTATS(1809,1) + +! ------------------------------------------------------------------ + +! Perform transform + +CALL EINV_TRANS_CTLAD(IF_UV_G,IF_SCALARS_G,IF_GP,IF_FS,IF_OUT_LT,& + & IF_UV,IF_SCALARS,IF_SCDERS,& + & PSPVOR,PSPDIV,PSPSCALAR,KVSETUV,KVSETSC,PGP,& + & PSPSC3A,PSPSC3B,PSPSC2,KVSETSC3A,KVSETSC3B,KVSETSC2,PGPUV,PGP3A,PGP3B,PGP2,& + & PMEANU,PMEANV) +IF (LHOOK) CALL DR_HOOK('EINV_TRANSAD',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +!endif INTERFACE + +END SUBROUTINE EINV_TRANSAD + diff --git a/src/etrans/etrans/external/esetup_trans.F90 b/src/etrans/etrans/external/esetup_trans.F90 new file mode 100644 index 000000000..f01b0a77c --- /dev/null +++ b/src/etrans/etrans/external/esetup_trans.F90 @@ -0,0 +1,308 @@ +SUBROUTINE ESETUP_TRANS(KMSMAX,KSMAX,KDGL,KDGUX,KLOEN,LDSPLIT,& + & KTMAX,KRESOL,PEXWN,PEYWN,PWEIGHT,LDGRIDONLY,KNOEXTZL,KNOEXTZG, & + & LDUSEFFTW,LD_ALL_FFTW) +!**** *ESETUP_TRANS* - Setup transform package for specific resolution + +! Purpose. +! -------- +! To setup for making spectral transforms. Each call to this routine +! creates a new resolution up to a maximum of NMAX_RESOL set up in +! SETUP_TRANS0. You need to call SETUP_TRANS0 before this routine can +! be called. + +!** Interface. +! ---------- +! CALL ESETUP_TRANS(...) + +! Explicit arguments : KLOEN,LDSPLIT are optional arguments +! -------------------- +! KSMAX - spectral truncation required +! KDGL - number of Gaussian latitudes +! KLOEN(:) - number of points on each Gaussian latitude [2*KDGL] +! LDSPLIT - true if split latitudes in grid-point space [false] +! KTMAX - truncation order for tendencies? +! KRESOL - the resolution identifier +! KSMAX,KDGL,KTMAX and KLOEN are GLOBAL variables desribing the resolution +! in spectral and grid-point space +! LDGRIDONLY - true if only grid space is required + + +! LDSPLIT describe the distribution among processors of +! grid-point data and has no relevance if you are using a single processor + +! LDUSEFFTW - Use FFTW for FFTs +! LD_ALL_FFTW : T to transform all fields in one call, F to transforms fields one after another + +! Method. +! ------- + +! Externals. ESET_RESOL - set resolution +! ---------- ESETUP_DIMS - setup distribution independent dimensions +! SUEMP_TRANS_PRELEG - first part of setup of distr. environment +! SULEG - Compute Legandre polonomial and Gaussian +! Latitudes and Weights +! ESETUP_GEOM - Compute arrays related to grid-point geometry +! SUEMP_TRANS - Second part of setup of distributed environment +! SUEFFT - setup for FFT + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-03-03 +! 02-04-11 A. Bogatchev: Passing of TCDIS +! 02-11-14 C. Fischer: soften test on KDGL +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! A.Nmiri 15-Nov-2007 Phasing with TFL 32R3 +! A.Bogatchev 16-Sep-2010 Phasing cy37 +! D. Degrauwe (Feb 2012): Alternative extension zone (E') +! R. El Khatib 02-Mar-2012 Support for mixed multi-resolutions +! R. El Khatib 09-Aug-2012 %LAM in GEOM_TYPE +! R. El Khatib 14-Jun-2013 LENABLED +! R. El Khatib 01-Sep-2015 Support for FFTW +! R. El Khatib 08-Jun-2023 LALL_FFTW for better flexibility +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +!ifndef INTERFACE + +USE TPM_GEN ,ONLY : NERR, NOUT, NPRINTLEV, MSETUP0, & + & NCUR_RESOL, NDEF_RESOL, NMAX_RESOL, LENABLED +USE TPM_DIM ,ONLY : R, DIM_RESOL +USE TPM_DISTR ,ONLY : D, DISTR_RESOL +USE TPM_GEOMETRY ,ONLY : G, GEOM_RESOL +USE TPM_FIELDS ,ONLY : FIELDS_RESOL +USE TPM_FFT ,ONLY : T, FFT_RESOL, TB, FFTB_RESOL +#ifdef WITH_FFTW +USE TPM_FFTW ,ONLY : TW, FFTW_RESOL +#endif +USE TPM_FLT ,ONLY : FLT_RESOL +USE TPM_CTL ,ONLY : CTL_RESOL + +USE TPMALD_DIM ,ONLY : RALD, ALDDIM_RESOL +USE TPMALD_DISTR ,ONLY : ALDDISTR_RESOL +USE TPMALD_FFT ,ONLY : TALD, ALDFFT_RESOL +USE TPMALD_FIELDS ,ONLY : ALDFIELDS_RESOL +USE TPMALD_GEO ,ONLY : GALD, ALDGEO_RESOL + +USE ESET_RESOL_MOD ,ONLY : ESET_RESOL +USE ESETUP_DIMS_MOD ,ONLY : ESETUP_DIMS +USE SUEMP_TRANS_MOD ,ONLY : SUEMP_TRANS +USE SUEMP_TRANS_PRELEG_MOD ,ONLY : SUEMP_TRANS_PRELEG +!USE SULEG_MOD +USE ESETUP_GEOM_MOD ,ONLY : ESETUP_GEOM +USE SUEFFT_MOD ,ONLY : SUEFFT +USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS + +!endif INTERFACE + +IMPLICIT NONE + +! Dummy arguments +INTEGER(KIND=JPIM),INTENT(IN) :: KMSMAX +INTEGER(KIND=JPIM),INTENT(IN) :: KSMAX +INTEGER(KIND=JPIM),INTENT(IN) :: KDGL +INTEGER(KIND=JPIM),INTENT(IN) :: KDGUX +INTEGER(KIND=JPIM),INTENT(IN) :: KLOEN(:) +LOGICAL ,OPTIONAL,INTENT(IN) :: LDSPLIT +LOGICAL ,OPTIONAL,INTENT(IN) :: LDGRIDONLY +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KTMAX +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KRESOL +REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PEXWN +REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PEYWN +REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PWEIGHT(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KNOEXTZL +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KNOEXTZG +LOGICAL ,OPTIONAL,INTENT(IN) :: LDUSEFFTW +LOGICAL ,OPTIONAL,INTENT(IN) :: LD_ALL_FFTW + +!ifndef INTERFACE + +! Local variables +LOGICAL :: LLP1,LLP2 +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +IF (LHOOK) CALL DR_HOOK('ESETUP_TRANS',0,ZHOOK_HANDLE) + +IF(MSETUP0 == 0) THEN + CALL ABORT_TRANS('ESETUP_TRANS: SETUP_TRANS0 HAS TO BE CALLED BEFORE ESETUP_TRANS') +ENDIF +LLP1 = NPRINTLEV>0 +LLP2 = NPRINTLEV>1 +IF(LLP1) WRITE(NOUT,*) '=== ENTER ROUTINE ESETUP_TRANS ===' + +! Allocate resolution dependent structures common to global and LAM +IF(.NOT. ALLOCATED(DIM_RESOL)) THEN + NDEF_RESOL = 1 + ALLOCATE(DIM_RESOL(NMAX_RESOL)) + ALLOCATE(FIELDS_RESOL(NMAX_RESOL)) + ALLOCATE(GEOM_RESOL(NMAX_RESOL)) + ALLOCATE(DISTR_RESOL(NMAX_RESOL)) + ALLOCATE(FFT_RESOL(NMAX_RESOL)) + ALLOCATE(FFTB_RESOL(NMAX_RESOL)) +#ifdef WITH_FFTW + ALLOCATE(FFTW_RESOL(NMAX_RESOL)) +#endif + ALLOCATE(FLT_RESOL(NMAX_RESOL)) + ALLOCATE(CTL_RESOL(NMAX_RESOL)) + GEOM_RESOL(:)%LAM=.FALSE. + ALLOCATE(LENABLED(NMAX_RESOL)) + LENABLED(:)=.FALSE. +ELSE + NDEF_RESOL = NDEF_RESOL+1 + IF(NDEF_RESOL > NMAX_RESOL) THEN + CALL ABORT_TRANS('ESETUP_TRANS:NDEF_RESOL > NMAX_RESOL') + ENDIF +ENDIF +! Allocate LAM-specific resolution dependent structures +IF(.NOT. ALLOCATED(ALDDIM_RESOL)) THEN + ALLOCATE(ALDDIM_RESOL(NMAX_RESOL)) + ALLOCATE(ALDFIELDS_RESOL(NMAX_RESOL)) + ALLOCATE(ALDGEO_RESOL(NMAX_RESOL)) + ALLOCATE(ALDDISTR_RESOL(NMAX_RESOL)) + ALLOCATE(ALDFFT_RESOL(NMAX_RESOL)) +ENDIF + + +IF (PRESENT(KRESOL)) THEN + KRESOL=NDEF_RESOL +ENDIF + +! Point at structures due to be initialized +CALL ESET_RESOL(NDEF_RESOL) +IF(LLP1) WRITE(NOUT,*) '=== DEFINING RESOLUTION ',NCUR_RESOL + +! Defaults for optional arguments + +G%LREDUCED_GRID = .FALSE. +D%LGRIDONLY = .FALSE. +D%LSPLIT = .FALSE. +TALD%LFFT992=.TRUE. ! Use FFT992 interface for FFTs +#ifdef WITH_FFTW +TW%LFFTW=.FALSE. ! Use FFTW interface for FFTs +TW%LALL_FFTW=.FALSE. ! transform fields one at a time +#endif + +! NON-OPTIONAL ARGUMENTS +R%NSMAX = KSMAX +RALD%NMSMAX=KMSMAX +RALD%NDGUX=KDGUX +R%NDGL = KDGL +RALD%NDGLSUR=KDGL+2 +R%NDLON =KLOEN(1) + +! IMPLICIT argument : +G%LAM = .TRUE. + +IF (KDGL <= 0) THEN + CALL ABORT_TRANS ('ESETUP_TRANS: KDGL IS NOT A POSITIVE NUMBER') +ENDIF + +! Optional arguments + +ALLOCATE(G%NLOEN(R%NDGL)) +IF(LLP2)WRITE(NOUT,9) 'NLOEN ',SIZE(G%NLOEN ),SHAPE(G%NLOEN ) + +IF (G%LREDUCED_GRID) THEN + G%NLOEN(:) = KLOEN(1:R%NDGL) +ELSE + G%NLOEN(:) = R%NDLON +ENDIF + +IF(PRESENT(LDSPLIT)) THEN + D%LSPLIT = LDSPLIT +ENDIF + +IF(PRESENT(KTMAX)) THEN + R%NTMAX = KTMAX +ELSE + R%NTMAX = R%NSMAX +ENDIF +IF(R%NTMAX /= R%NSMAX) THEN + !This SHOULD work but I don't know how to test it /MH + WRITE(NERR,*) 'R%NTMAX /= R%NSMAX',R%NTMAX,R%NSMAX + CALL ABORT_TRANS('ESETUP_TRANS:R%NTMAX /= R%NSMAX HAS NOT BEEN VALIDATED') +ENDIF + +IF(PRESENT(PWEIGHT)) THEN + D%LWEIGHTED_DISTR = .TRUE. + IF( D%LWEIGHTED_DISTR .AND. .NOT.D%LSPLIT )THEN + CALL ABORT_TRANS('SETUP_TRANS: LWEIGHTED_DISTR=T AND LSPLIT=F NOT SUPPORTED') + ENDIF + IF(SIZE(PWEIGHT) /= SUM(G%NLOEN(:)) )THEN + CALL ABORT_TRANS('SETUP_TRANS:SIZE(PWEIGHT) /= SUM(G%NLOEN(:))') + ENDIF + ALLOCATE(D%RWEIGHT(SIZE(PWEIGHT))) + D%RWEIGHT(:)=PWEIGHT(:) +ELSE + D%LWEIGHTED_DISTR = .FALSE. +ENDIF + +IF(PRESENT(LDGRIDONLY)) THEN + D%LGRIDONLY=LDGRIDONLY +ENDIF + +IF (PRESENT(KNOEXTZL)) THEN + R%NNOEXTZL=KNOEXTZL +ELSE + R%NNOEXTZL=0 +ENDIF + +IF (PRESENT(KNOEXTZG)) THEN + R%NNOEXTZG=KNOEXTZG +ELSE + R%NNOEXTZG=0 +ENDIF + +#ifdef WITH_FFTW +IF(PRESENT(LDUSEFFTW)) THEN + TW%LFFTW=LDUSEFFTW +ENDIF +IF(PRESENT(LD_ALL_FFTW)) THEN + TW%LALL_FFTW=LD_ALL_FFTW +ENDIF +#endif + +IF(PRESENT(LDUSEFFTW)) THEN + TALD%LFFT992=.NOT.LDUSEFFTW +ELSE + TALD%LFFT992=.TRUE. +ENDIF + +! Setup resolution dependent structures +! ------------------------------------- + +! Setup distribution independent dimensions +CALL ESETUP_DIMS +IF (PRESENT(PEXWN)) GALD%EXWN=PEXWN +IF (PRESENT(PEYWN)) GALD%EYWN=PEYWN + +! First part of setup of distributed environment +CALL SUEMP_TRANS_PRELEG + +CALL GSTATS(1802,0) +! Compute arrays related to grid-point geometry +CALL ESETUP_GEOM +! Second part of setup of distributed environment +CALL SUEMP_TRANS +! Initialize Fast Fourier Transform package +CALL SUEFFT +CALL GSTATS(1802,1) + +! Signal the current resolution is active +LENABLED(NDEF_RESOL)=.TRUE. + +IF (LHOOK) CALL DR_HOOK('ESETUP_TRANS',1,ZHOOK_HANDLE) +! ------------------------------------------------------------------ +9 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8) + +!endif INTERFACE + +END SUBROUTINE ESETUP_TRANS + diff --git a/src/etrans/etrans/external/especnorm.F90 b/src/etrans/etrans/external/especnorm.F90 new file mode 100644 index 000000000..f816ee4c0 --- /dev/null +++ b/src/etrans/etrans/external/especnorm.F90 @@ -0,0 +1,136 @@ +SUBROUTINE ESPECNORM(PSPEC,KVSET,KMASTER,KRESOL,PMET,PNORM) + +!**** *ESPECNORM* - Compute global spectral norms + +! Purpose. +! -------- +! Interface routine for computing spectral norms + +!** Interface. +! ---------- +! CALL ESPECNORM(...) + +! Explicit arguments : All arguments optional +! -------------------- +! PSPEC(:,:) - Spectral array +! KVSET(:) - "B-Set" for each field +! KMASTER - processor to recieve norms +! KRESOL - resolution tag which is required ,default is the +! first defined resulution (input) +! PMET(:) - metric +! PNORM(:) - Norms (output for processor KMASTER) + +! Method. +! ------- + +! Externals. ESET_RESOL - set resolution +! ---------- ESPNORM_CTL - control routine + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-03-03 +! M.Hamrud 01-Oct-2003 CY28 Cleaning + +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +!ifndef INTERFACE + +USE TPM_GEN ,ONLY : NERR +!USE TPM_DIM +USE TPM_DISTR ,ONLY : D, NPRTRV, MYSETV, MYPROC + +USE ESET_RESOL_MOD ,ONLY : ESET_RESOL +USE ESPNORM_CTL_MOD ,ONLY : ESPNORM_CTL +USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS + +!endif INTERFACE + +IMPLICIT NONE + +! Declaration of arguments + +REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PSPEC(:,:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KVSET(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KMASTER +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KRESOL +REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PMET(:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PNORM(:) +!ifndef INTERFACE + +INTEGER(KIND=JPIM) :: IMASTER,IFLD,IFLD_G,J +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +! Set current resolution +IF (LHOOK) CALL DR_HOOK('ESPECNORM',0,ZHOOK_HANDLE) +CALL ESET_RESOL(KRESOL) + +! Set defaults +IMASTER = 1 +IFLD = 0 + +IF(PRESENT(KMASTER)) THEN + IMASTER = KMASTER +ENDIF + +IF(PRESENT(KVSET)) THEN + IFLD_G = UBOUND(KVSET,1) + DO J=1,IFLD_G + IF(KVSET(J) > NPRTRV) THEN + WRITE(NERR,*) 'ESPECNORM:KVSET(J) > NPRTRV ',J,KVSET(J),NPRTRV + CALL ABORT_TRANS('ESPECNORM:KVSET TOO LONG OR CONTAINS VALUES OUTSIDE RANGE') + ENDIF + IF(KVSET(J) == MYSETV) THEN + IFLD = IFLD+1 + ENDIF + ENDDO +ELSE + IF(PRESENT(PSPEC)) THEN + IFLD = UBOUND(PSPEC,1) + ENDIF + IFLD_G = IFLD +ENDIF + +IF(NPRTRV >1) THEN + IF(IFLD > 0 .AND. .NOT. PRESENT(KVSET)) THEN + WRITE(NERR,*)'NPRTRV >1 AND IFLD > 0 AND NOT PRESENT(KVSET)',& + & NPRTRV,IFLD + CALL ABORT_TRANS('ESPECNORM: SPECIFY VERTICAL SPECTRAL DISTRIBUTION!') + ENDIF +ENDIF +IF(MYPROC == IMASTER) THEN + IF(.NOT. PRESENT(PNORM)) THEN + CALL ABORT_TRANS('ESPECNORM: PNORM NOT PRESENT') + ENDIF + IF(UBOUND(PNORM,1) < IFLD_G) THEN + CALL ABORT_TRANS('ESPECNORM: PNORM TOO SMALL') + ENDIF +ENDIF +IF(IFLD > 0 ) THEN + IF(.NOT. PRESENT(PSPEC)) THEN + CALL ABORT_TRANS('ESPECNORM: PSPEC NOT PRESENT') + ENDIF + IF(UBOUND(PSPEC,1) < IFLD) THEN + CALL ABORT_TRANS('ESPECNORM: FIRST DIMENSION OF PSPEC TOO SMALL') + ENDIF + IF(UBOUND(PSPEC,2) < D%NSPEC2) THEN + CALL ABORT_TRANS('ESPECNORM: FIRST DIMENSION OF PSPEC TOO SMALL') + ENDIF +ENDIF + +CALL ESPNORM_CTL(PSPEC,IFLD,IFLD_G,KVSET,IMASTER,PMET,PNORM) +IF (LHOOK) CALL DR_HOOK('ESPECNORM',1,ZHOOK_HANDLE) + +!endif INTERFACE + +! ------------------------------------------------------------------ + +END SUBROUTINE ESPECNORM diff --git a/src/etrans/etrans/external/etrans_end.F90 b/src/etrans/etrans/external/etrans_end.F90 new file mode 100644 index 000000000..18905e499 --- /dev/null +++ b/src/etrans/etrans/external/etrans_end.F90 @@ -0,0 +1,147 @@ +SUBROUTINE ETRANS_END(CDMODE) + +!**** *ETRANS_END* - Terminate transform package + +! Purpose. +! -------- +! Terminate transform package. Release all allocated arrays. + +!** Interface. +! ---------- +! CALL ETRANS_END + +! Explicit arguments : None +! -------------------- + +! Method. +! ------- + +! Externals. None +! ---------- + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-03-03 +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! A.Nmiri 15-Nov-2007 Phasing with TFL 32R3 +! A.Bogatchev 16-Sep-2010 Phasing cy37 after G.Radnoti +! R. El Khatib 02-Mar-2012 Support for mixed multi-resolutions +! R. El Khatib 09-Jul-2013 LENABLED +! R. El Khatib 01-Set-2015 Support for FFTW +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +!ifndef INTERFACE + +USE TPM_GEN ,ONLY : MSETUP0, NCUR_RESOL, NDEF_RESOL, NMAX_RESOL, LENABLED +USE TPM_DIM ,ONLY : R, DIM_RESOL +USE TPM_DISTR ,ONLY : D, DISTR_RESOL, NPRCIDS +USE TPM_GEOMETRY ,ONLY : G, GEOM_RESOL +USE TPM_FIELDS ,ONLY : F, FIELDS_RESOL +USE TPM_FFT ,ONLY : T, FFT_RESOL, TB, FFTB_RESOL +#ifdef WITH_FFTW +USE TPM_FFTW ,ONLY : TW, FFTW_RESOL +#endif +USE TPM_FLT ,ONLY : S, FLT_RESOL +USE TPM_TRANS ,ONLY : FOUBUF, FOUBUF_IN +USE TPMALD_DIM ,ONLY : RALD, ALDDIM_RESOL +USE TPMALD_DISTR ,ONLY : DALD, ALDDISTR_RESOL +USE TPMALD_FFT ,ONLY : TALD, ALDFFT_RESOL +USE TPMALD_FIELDS ,ONLY : FALD, ALDFIELDS_RESOL +USE TPMALD_GEO ,ONLY : GALD, ALDGEO_RESOL + +USE ESET_RESOL_MOD ,ONLY : ESET_RESOL +USE EQ_REGIONS_MOD ,ONLY : N_REGIONS +USE EDEALLOC_RESOL_MOD ,ONLY : EDEALLOC_RESOL + +IMPLICIT NONE + +CHARACTER*5, OPTIONAL, INTENT(IN) :: CDMODE +! Local variables +CHARACTER*5 :: CLMODE +INTEGER(KIND=JPIM) :: JRES +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE +! ------------------------------------------------------------------ + +IF (LHOOK) CALL DR_HOOK('ETRANS_END',0,ZHOOK_HANDLE) +CLMODE='FINAL' +IF (PRESENT(CDMODE)) CLMODE=CDMODE +IF (CLMODE == 'FINAL') THEN + DO JRES=1,NDEF_RESOL + CALL EDEALLOC_RESOL(JRES) + ENDDO + NULLIFY(R) + IF (ALLOCATED(DIM_RESOL)) DEALLOCATE(DIM_RESOL) + NULLIFY(RALD) + IF (ALLOCATED(ALDDIM_RESOL)) DEALLOCATE(ALDDIM_RESOL) +!EQ_REGIONS + IF (ASSOCIATED(N_REGIONS)) THEN + DEALLOCATE(N_REGIONS) + NULLIFY (N_REGIONS) + ENDIF +!TPM_DISTR + NULLIFY(D) + IF (ALLOCATED(DISTR_RESOL)) DEALLOCATE(DISTR_RESOL) + NULLIFY(DALD) + IF (ALLOCATED(ALDDISTR_RESOL)) DEALLOCATE(ALDDISTR_RESOL) +!TPM_FFT + NULLIFY(T) + IF (ALLOCATED(FFT_RESOL)) DEALLOCATE(FFT_RESOL) + NULLIFY(TB) + IF( ALLOCATED(FFTB_RESOL) ) DEALLOCATE(FFTB_RESOL) +#ifdef WITH_FFTW + !TPM_FFTW + NULLIFY(TW) + DEALLOCATE(FFTW_RESOL) +#endif +!TPM_FLT + NULLIFY(S) + IF (ALLOCATED(FLT_RESOL)) DEALLOCATE(FLT_RESOL) + NULLIFY(TALD) + IF (ALLOCATED(ALDFFT_RESOL)) DEALLOCATE(ALDFFT_RESOL) + +!TPM_FIELDS + NULLIFY(F) + IF (ALLOCATED(FIELDS_RESOL)) DEALLOCATE(FIELDS_RESOL) + NULLIFY(FALD) + IF (ALLOCATED(ALDFIELDS_RESOL)) DEALLOCATE(ALDFIELDS_RESOL) + +!TPM_GEOMETRY + NULLIFY(G) + IF(ALLOCATED(GEOM_RESOL)) DEALLOCATE(GEOM_RESOL) + NULLIFY(GALD) + IF(ALLOCATED(ALDGEO_RESOL)) DEALLOCATE(ALDGEO_RESOL) +!TPM_TRANS + IF(ALLOCATED(FOUBUF_IN)) DEALLOCATE(FOUBUF_IN) + IF(ALLOCATED(FOUBUF)) DEALLOCATE(FOUBUF) + + IF (ALLOCATED(LENABLED)) DEALLOCATE(LENABLED) + MSETUP0 = 0 + NMAX_RESOL = 0 + NCUR_RESOL = 0 + NDEF_RESOL = 0 +ENDIF + +IF (CLMODE == 'FINAL' .OR. CLMODE == 'INTER') THEN + !EQ_REGIONS + IF (ASSOCIATED(N_REGIONS)) THEN + DEALLOCATE(N_REGIONS) + NULLIFY (N_REGIONS) + ENDIF + !TPM_DISTR + IF (ALLOCATED(NPRCIDS)) DEALLOCATE(NPRCIDS) +ENDIF +IF (LHOOK) CALL DR_HOOK('ETRANS_END',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +!endif INTERFACE + +END SUBROUTINE ETRANS_END + diff --git a/src/etrans/etrans/external/etrans_inq.F90 b/src/etrans/etrans/external/etrans_inq.F90 new file mode 100644 index 000000000..1d580d60f --- /dev/null +++ b/src/etrans/etrans/external/etrans_inq.F90 @@ -0,0 +1,539 @@ +SUBROUTINE ETRANS_INQ(KRESOL,KSPEC,KSPEC2,KSPEC2G,KSPEC2MX,KNUMP,& + & KGPTOT,KGPTOTG,KGPTOTMX,KGPTOTL,& + & KMYMS,KESM0,KUMPP,KPOSSP,KPTRMS,KALLMS,KDIM0G,& + & KFRSTLAT,KLSTLAT,KFRSTLOFF,KPTRLAT,& + & KPTRFRSTLAT,KPTRLSTLAT,KPTRFLOFF,KSTA,KONL,& + & KULTPP,KPTRLS,& + & KPRTRW,KMYSETW,KMYSETV,KMY_REGION_NS,KMY_REGION_EW,& + & LDSPLITLAT,LDLINEAR_GRID,& + & KSMAX,KMSMAX,KNVALUE,KMVALUE,PLEPINM,KDEF_RESOL,LDLAM,& + & PMU,PGW,PRPNM,KLEI3,KSPOLEGL,KPMS,KCPL2M,KCPL4M ,KPROCM) + +!**** *ETRANS_INQ* - Extract information from the transform package + +! Purpose. +! -------- +! Interface routine for extracting information from the T.P. + +!** Interface. +! ---------- +! CALL ETRANS_INQ(...) +! Explicit arguments : All arguments are optional. +! -------------------- +! KRESOL - resolution tag for which info is required ,default is the +! first defined resolution (input) + +! MULTI-TRANSFORMS MANAGEMENT +! KDEF_RESOL - number or resolutions defined +! LDLAM - .T. if the corresponding resolution is LAM, .F. if it is global + +! SPECTRAL SPACE +! KSPEC - number of complex spectral coefficients on this PE +! KSPEC2 - 2*KSPEC +! KSPEC2G - global KSPEC2 +! KSPEC2MX - maximun KSPEC2 among all PEs +! KNUMP - Number of spectral waves handled by this PE +! KGPTOT - Total number of grid columns on this PE +! KGPTOTG - Total number of grid columns on the Globe +! KGPTOTMX - Maximum number of grid columns on any of the PEs +! KGPTOTL - Number of grid columns one each PE (dimension +! N_REGIONS_NS:N_REGIONS_EW) +! KMYMS - This PEs spectral zonal wavenumbers +! KESM0 - Address in a spectral array of (m, n=m) +! KUMPP - No. of wave numbers each wave set is responsible for +! KPOSSP - Defines partitioning of global spectral fields among PEs +! KPTRMS - Pointer to the first wave number of a given a-set +! KALLMS - Wave numbers for all wave-set concatenated together +! to give all wave numbers in wave-set order +! KDIM0G - Defines partitioning of global spectral fields among PEs +! KSMAX - spectral truncation - n direction +! KMSMAX - spectral truncation - m direction +! KNVALUE - n value for each KSPEC2 spectral coeffient +! KMVALUE - m value for each KSPEC2 spectral coeffient +! LDLINEAR_GRID : .TRUE. if the grid is linear + +! GRIDPOINT SPACE +! KFRSTLAT - First latitude of each a-set in grid-point space +! KLSTTLAT - Last latitude of each a-set in grid-point space +! KFRSTLOFF - Offset for first lat of own a-set in grid-point space +! KPTRLAT - Pointer to the start of each latitude +! KPTRFRSTLAT - Pointer to the first latitude of each a-set in +! NSTA and NONL arrays +! KPTRLSTLAT - Pointer to the last latitude of each a-set in +! NSTA and NONL arrays +! KPTRFLOFF - Offset for pointer to the first latitude of own a-set +! NSTA and NONL arrays, i.e. nptrfrstlat(myseta)-1 +! KSTA - Position of first grid column for the latitudes on a +! processor. The information is available for all processors. +! The b-sets are distinguished by the last dimension of +! nsta().The latitude band for each a-set is addressed by +! nptrfrstlat(jaset),nptrlstlat(jaset), and +! nptrfloff=nptrfrstlat(myseta) on this processors a-set. +! Each split latitude has two entries in nsta(,:) which +! necessitates the rather complex addressing of nsta(,:) +! and the overdimensioning of nsta by N_REGIONS_NS. +! KONL - Number of grid columns for the latitudes on a processor. +! Similar to nsta() in data structure. +! LDSPLITLAT - TRUE if latitude is split in grid point space over +! two a-sets + +! FOURIER SPACE +! KULTPP - number of latitudes for which each a-set is calculating +! the FFT's. +! KPTRLS - pointer to first global latitude of each a-set for which +! it performs the Fourier calculations + +! LEGENDRE +! PMU - sin(Gaussian latitudes) +! PGW - Gaussian weights +! PRPNM - Legendre polynomials +! KLEI3 - First dimension of Legendre polynomials +! KSPOLEGL - Second dimension of Legendre polynomials +! KPMS - Adress for legendre polynomial for given M (NSMAX) +! PLEPINM - Eigen-values of the inverse Laplace operator + +! Method. +! ------- + +! Externals. ESET_RESOL - set resolution +! ---------- + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-03-03 +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! A.Nmiri 15-Nov-2007 Phasing with TFL 32R3 +! A.Bogatchev 16-Sep-2010 Phasing with TFL 36R4 +! R. El Khatib 08-Aug-2012 KSMAX,KMSMAX,KNVALUE,KMVALUE,PLEPINM,LDLAM,KDEF_RESOL,LDLINEAR_GRID +! T. Dalkilic 28-Aug-2012 KCPL4M +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +!ifndef INTERFACE + +USE TPM_GEN ,ONLY : NDEF_RESOL +USE TPM_DIM ,ONLY : R +USE TPM_DISTR ,ONLY : D, NPRTRNS, NPRTRW, MYSETV, MYSETW +USE TPMALD_DIM ,ONLY : RALD +USE TPMALD_DISTR ,ONLY : DALD +USE TPM_GEOMETRY ,ONLY : G +USE TPM_FIELDS ,ONLY : F +USE TPMALD_FIELDS + +USE EQ_REGIONS_MOD ,ONLY : MY_REGION_EW, MY_REGION_NS, & + & N_REGIONS_EW, N_REGIONS_NS +USE ESET_RESOL_MOD ,ONLY : ESET_RESOL +USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS + +!endif INTERFACE + +IMPLICIT NONE + +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KRESOL +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KSPEC +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KSPEC2 +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KSPEC2G +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KSPEC2MX +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KNUMP +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KGPTOT +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KGPTOTG +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KGPTOTMX +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KGPTOTL(:,:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KMYMS(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KESM0(0:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KUMPP(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KPOSSP(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KPTRMS(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KALLMS(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KDIM0G(0:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KFRSTLAT(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KLSTLAT(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KFRSTLOFF +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KPTRLAT(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KPTRFRSTLAT(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KPTRLSTLAT(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KPTRFLOFF +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KSTA(:,:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KONL(:,:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KULTPP(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KPTRLS(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPRTRW +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KMYSETW +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KMYSETV +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KMY_REGION_NS +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KMY_REGION_EW +LOGICAL ,OPTIONAL,INTENT(INOUT) :: LDSPLITLAT(:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(INOUT) :: PMU(:) +REAL(KIND=JPRB) ,OPTIONAL :: PGW(:) ! Argument NOT used +REAL(KIND=JPRB) ,OPTIONAL,INTENT(INOUT) :: PRPNM(:,:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KLEI3 +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KSPOLEGL +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KPMS(0:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KCPL2M(0:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KCPL4M(0:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KPROCM(0:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KSMAX +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KMSMAX +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KNVALUE(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KMVALUE(:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PLEPINM(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KDEF_RESOL +LOGICAL ,OPTIONAL,INTENT(OUT) :: LDLAM +LOGICAL ,OPTIONAL,INTENT(OUT) :: LDLINEAR_GRID +!ifndef INTERFACE + +INTEGER(KIND=JPIM) :: IU1,IU2 +INTEGER(KIND=JPIM) :: IC, JN, JMLOC, IM, JJ, JM +INTEGER(KIND=JPIM) :: ISMAX(0:R%NSMAX),ISNAX(0:RALD%NMSMAX),ICPLM(0:RALD%NMSMAX) + +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE +! ------------------------------------------------------------------ + +! Set current resolution +IF (LHOOK) CALL DR_HOOK('ETRANS_INQ',0,ZHOOK_HANDLE) +CALL ESET_RESOL(KRESOL) + +IF(PRESENT(KSPEC)) KSPEC = D%NSPEC +IF(PRESENT(KSPEC2)) KSPEC2 = D%NSPEC2 +IF(PRESENT(KSPEC2G)) KSPEC2G = R%NSPEC2_G +IF(PRESENT(KSPEC2MX)) KSPEC2MX = D%NSPEC2MX +IF(PRESENT(KNUMP)) KNUMP = D%NUMP +IF(PRESENT(KGPTOT)) KGPTOT = D%NGPTOT +IF(PRESENT(KGPTOTG)) KGPTOTG = D%NGPTOTG +IF(PRESENT(KGPTOTMX)) KGPTOTMX = D%NGPTOTMX +IF(PRESENT(KFRSTLOFF)) KFRSTLOFF = D%NFRSTLOFF +IF(PRESENT(KPTRFLOFF)) KPTRFLOFF = D%NPTRFLOFF +IF(PRESENT(KPRTRW)) KPRTRW = NPRTRW +IF(PRESENT(KMYSETW)) KMYSETW = MYSETW +IF(PRESENT(KMYSETV)) KMYSETV = MYSETV +IF(PRESENT(KMY_REGION_NS)) KMY_REGION_NS = MY_REGION_NS +IF(PRESENT(KMY_REGION_EW)) KMY_REGION_EW = MY_REGION_EW +IF(PRESENT(LDLAM)) LDLAM = G%LAM +IF(PRESENT(KDEF_RESOL)) KDEF_RESOL = NDEF_RESOL + +IF(PRESENT(KGPTOTL)) THEN + IF(UBOUND(KGPTOTL,1) < N_REGIONS_NS) THEN + CALL ABORT_TRANS('ETRANS_INQ: KGPTOTL DIM 1 TOO SMALL') + ELSEIF(UBOUND(KGPTOTL,2) < N_REGIONS_EW) THEN + CALL ABORT_TRANS('ETRANS_INQ: KGPTOTL DIM 2 TOO SMALL') + ELSE + KGPTOTL(1:N_REGIONS_NS,1:N_REGIONS_EW) = D%NGPTOTL(:,:) + ENDIF +ENDIF + +IF(PRESENT(KMYMS)) THEN + IF(D%LGRIDONLY) THEN + CALL ABORT_TRANS('ETRANS_INQ: KMYMS REQUIRED BUT LGRIDONLY=T') + ENDIF + IF(UBOUND(KMYMS,1) < D%NUMP) THEN + CALL ABORT_TRANS('ETRANS_INQ: KMYMS TOO SMALL') + ELSE + KMYMS(1:D%NUMP) = D%MYMS(:) + ENDIF +ENDIF + +IF(PRESENT(KESM0)) THEN + IF(D%LGRIDONLY) THEN + CALL ABORT_TRANS('ETRANS_INQ: KESM0 REQUIRED BUT LGRIDONLY=T') + ENDIF + IF(UBOUND(KESM0,1) < RALD%NMSMAX) THEN + CALL ABORT_TRANS('ETRANS_INQ: KESM0 TOO SMALL') + ELSE + KESM0(0:RALD%NMSMAX) = DALD%NESM0(:) + ENDIF +ENDIF + +IF(PRESENT(KCPL2M)) THEN + IF(UBOUND(KCPL2M,1) < RALD%NMSMAX) THEN + CALL ABORT_TRANS('ETRANS_INQ: KCPL2M TOO SMALL') + ELSE + KCPL2M(0:RALD%NMSMAX) = DALD%NCPL2M(:) + ENDIF +ENDIF +IF(PRESENT(KPROCM)) THEN + IF(UBOUND(KPROCM,1) < RALD%NMSMAX) THEN + CALL ABORT_TRANS('ETRANS_INQ: KPROCM TOO SMALL') + ELSE + KPROCM(0:RALD%NMSMAX) = D%NPROCM(:) + ENDIF +ENDIF + +IF(PRESENT(KUMPP)) THEN + IF(D%LGRIDONLY) THEN + CALL ABORT_TRANS('ETRANS_INQ: KUMPP REQUIRED BUT LGRIDONLY=T') + ENDIF + IF(UBOUND(KUMPP,1) < NPRTRW) THEN + CALL ABORT_TRANS('ETRANS_INQ: KUMPP TOO SMALL') + ELSE + KUMPP(1:NPRTRW) = D%NUMPP(:) + ENDIF +ENDIF + +IF(PRESENT(KPOSSP)) THEN + IF(D%LGRIDONLY) THEN + CALL ABORT_TRANS('ETRANS_INQ: KPOSSP REQUIRED BUT LGRIDONLY=T') + ENDIF + IF(UBOUND(KPOSSP,1) < NPRTRW+1) THEN + CALL ABORT_TRANS('ETRANS_INQ: KPOSSP TOO SMALL') + ELSE + KPOSSP(1:NPRTRW+1) = D%NPOSSP(:) + ENDIF +ENDIF + +IF(PRESENT(KPTRMS)) THEN + IF(D%LGRIDONLY) THEN + CALL ABORT_TRANS('ETRANS_INQ: KPTRMS REQUIRED BUT LGRIDONLY=T') + ENDIF + IF(UBOUND(KPTRMS,1) < NPRTRW) THEN + CALL ABORT_TRANS('ETRANS_INQ: KPTRMS TOO SMALL') + ELSE + KPTRMS(1:NPRTRW) = D%NPTRMS(:) + ENDIF +ENDIF + +IF(PRESENT(KALLMS)) THEN + IF(D%LGRIDONLY) THEN + CALL ABORT_TRANS('ETRANS_INQ: KALLMS REQUIRED BUT LGRIDONLY=T') + ENDIF + IF(UBOUND(KALLMS,1) < RALD%NMSMAX+1) THEN + CALL ABORT_TRANS('ETRANS_INQ: KALLMS TOO SMALL') + ELSE + KALLMS(1:RALD%NMSMAX+1) = D%NALLMS(:) + ENDIF +ENDIF + +IF(PRESENT(KDIM0G)) THEN + IF(D%LGRIDONLY) THEN + CALL ABORT_TRANS('ETRANS_INQ: KDIM0G REQUIRED BUT LGRIDONLY=T') + ENDIF + IF(UBOUND(KDIM0G,1) < RALD%NMSMAX) THEN + CALL ABORT_TRANS('ETRANS_INQ: KDIM0G TOO SMALL') + ELSE + KDIM0G(0:RALD%NMSMAX) = D%NDIM0G(0:RALD%NMSMAX) + ENDIF +ENDIF + +IF(PRESENT(KFRSTLAT)) THEN + IF(UBOUND(KFRSTLAT,1) < N_REGIONS_NS) THEN + CALL ABORT_TRANS('ETRANS_INQ: KFRSTLAT TOO SMALL') + ELSE + KFRSTLAT(1:N_REGIONS_NS) = D%NFRSTLAT(:) + ENDIF +ENDIF + +IF(PRESENT(KLSTLAT)) THEN + IF(UBOUND(KLSTLAT,1) < N_REGIONS_NS) THEN + CALL ABORT_TRANS('ETRANS_INQ: KLSTLAT TOO SMALL') + ELSE + KLSTLAT(1:N_REGIONS_NS) = D%NLSTLAT(:) + ENDIF +ENDIF + +IF(PRESENT(KPTRLAT)) THEN + IF(UBOUND(KPTRLAT,1) < R%NDGL) THEN + CALL ABORT_TRANS('ETRANS_INQ: KPTRLAT TOO SMALL') + ELSE + KPTRLAT(1:R%NDGL) = D%NPTRLAT(:) + ENDIF +ENDIF + +IF(PRESENT(KPTRFRSTLAT)) THEN + IF(UBOUND(KPTRFRSTLAT,1) < N_REGIONS_NS) THEN + CALL ABORT_TRANS('ETRANS_INQ: KPTRFRSTLAT TOO SMALL') + ELSE + KPTRFRSTLAT(1:N_REGIONS_NS) = D%NPTRFRSTLAT(:) + ENDIF +ENDIF + +IF(PRESENT(KPTRLSTLAT)) THEN + IF(UBOUND(KPTRLSTLAT,1) < N_REGIONS_NS) THEN + CALL ABORT_TRANS('ETRANS_INQ: KPTRLSTLAT TOO SMALL') + ELSE + KPTRLSTLAT(1:N_REGIONS_NS) = D%NPTRLSTLAT(:) + ENDIF +ENDIF + +IF(PRESENT(KSTA)) THEN + IF(UBOUND(KSTA,1) < R%NDGL+N_REGIONS_NS-1) THEN + CALL ABORT_TRANS('ETRANS_INQ: KSTA DIM 1 TOO SMALL') + ELSEIF(UBOUND(KSTA,2) < N_REGIONS_EW) THEN + CALL ABORT_TRANS('ETRANS_INQ: KSTA DIM 2 TOO SMALL') + ELSE + KSTA(1:R%NDGL+N_REGIONS_NS-1,1:N_REGIONS_EW) = D%NSTA(:,:) + ENDIF +ENDIF + +IF(PRESENT(KONL)) THEN + IF(UBOUND(KONL,1) < R%NDGL+N_REGIONS_NS-1) THEN + CALL ABORT_TRANS('ETRANS_INQ: KONL DIM 1 TOO SMALL') + ELSEIF(UBOUND(KONL,2) < N_REGIONS_EW) THEN + CALL ABORT_TRANS('ETRANS_INQ: KONL DIM 2 TOO SMALL') + ELSE + KONL(1:R%NDGL+N_REGIONS_NS-1,1:N_REGIONS_EW) = D%NONL(:,:) + ENDIF +ENDIF + +IF(PRESENT(LDSPLITLAT)) THEN + IF(UBOUND(LDSPLITLAT,1) < R%NDGL) THEN + CALL ABORT_TRANS('ETRANS_INQ: LDSPLITLAT TOO SMALL') + ELSE + LDSPLITLAT(1:R%NDGL) = D%LSPLITLAT(:) + ENDIF +ENDIF + +IF(PRESENT(KULTPP)) THEN + IF(D%LGRIDONLY) THEN + CALL ABORT_TRANS('ETRANS_INQ: KULTPP REQUIRED BUT LGRIDONLY=T') + ENDIF + IF(UBOUND(KULTPP,1) < NPRTRNS) THEN + CALL ABORT_TRANS('ETRANS_INQ: KULTPP TOO SMALL') + ELSE + KULTPP(1:NPRTRNS) = D%NULTPP(:) + ENDIF +ENDIF + +IF(PRESENT(KPTRLS)) THEN + IF(D%LGRIDONLY) THEN + CALL ABORT_TRANS('ETRANS_INQ: KPTRLS REQUIRED BUT LGRIDONLY=T') + ENDIF + IF(UBOUND(KPTRLS,1) < NPRTRNS) THEN + CALL ABORT_TRANS('ETRANS_INQ: KPTRLS TOO SMALL') + ELSE + KPTRLS(1:NPRTRNS) = D%NPTRLS(:) + ENDIF +ENDIF + +IF(PRESENT(PMU)) THEN + IF(UBOUND(PMU,1) < R%NDGL) THEN + CALL ABORT_TRANS('ETRANS_INQ: PMU TOO SMALL') + ELSE + PMU(1:R%NDGL) = F%RMU + ENDIF +ENDIF + +IF(PRESENT(PRPNM)) THEN + IF(D%LGRIDONLY) THEN + CALL ABORT_TRANS('ETRANS_INQ: PRPNM REQUIRED BUT LGRIDONLY=T') + ENDIF + IU1 = UBOUND(PRPNM,1) + IU2 = UBOUND(PRPNM,2) + IF(IU1 < R%NDGNH) THEN + CALL ABORT_TRANS('ETRANS_INQ:FIRST DIM. OF PRNM TOO SMALL') + ELSE + IU1 = MIN(IU1,R%NLEI3) + IU2 = MIN(IU2,D%NSPOLEGL) + PRPNM(1:IU1,1:IU2) = F%RPNM(1:IU1,1:IU2) + ENDIF +ENDIF +IF(PRESENT(KLEI3)) THEN + KLEI3=R%NLEI3 +ENDIF +IF(PRESENT(KSPOLEGL)) THEN + KSPOLEGL=D%NSPOLEGL +ENDIF +IF(PRESENT(KPMS)) THEN + IF(D%LGRIDONLY) THEN + CALL ABORT_TRANS('ETRANS_INQ: KPMS REQUIRED BUT LGRIDONLY=T') + ENDIF + IF(UBOUND(KPMS,1) < R%NSMAX) THEN + CALL ABORT_TRANS('ETRANS_INQ: KPMS TOO SMALL') + ELSE + KPMS(0:R%NSMAX) = D%NPMS(0:R%NSMAX) + ENDIF +ENDIF + +IF(PRESENT(KSMAX)) KSMAX = R%NSMAX +IF(PRESENT(KMSMAX)) KMSMAX = RALD%NMSMAX +IF(PRESENT(PLEPINM)) THEN + IF(D%LGRIDONLY) THEN + CALL ABORT_TRANS('ETRANS_INQ: PLEPINM REQUIRED BUT LGRIDONLY=T') + ENDIF + IF(UBOUND(PLEPINM,1) < R%NSPEC_G/2) THEN + CALL ABORT_TRANS('ETRANS_INQ: PLEPINM TOO SMALL') + ELSEIF (LBOUND(PLEPINM,1) /= -1) THEN + CALL ABORT_TRANS('ETRANS_INQ: LOWER BOUND OF PLEPINM SHOULD BE -1') + ELSE + PLEPINM(:) = FALD%RLEPINM(:) + ENDIF +ENDIF +IF(PRESENT(KNVALUE)) THEN + IF(D%LGRIDONLY) THEN + CALL ABORT_TRANS('ETRANS_INQ: KNVALUE REQUIRED BUT LGRIDONLY=T') + ENDIF + IF(SIZE(KNVALUE) < D%NSPEC2) THEN + CALL ABORT_TRANS('ETRANS_INQ: KNVALUE TOO SMALL') + ELSE + CALL ELLIPS(R%NSMAX,RALD%NMSMAX,ISNAX,ISMAX) + DO JM=0,RALD%NMSMAX + ICPLM(JM) = 1*(ISNAX(JM)+1) + ENDDO + IC=1 + DO JMLOC=1,D%NUMP + IM=D%MYMS(JMLOC) + DO JN=0,ICPLM(IM)-1 + DO JJ=0,3 + KNVALUE(IC+JJ)=JN + ENDDO + IC=IC+4 + ENDDO + ENDDO + ENDIF +ENDIF + +IF(PRESENT(KMVALUE)) THEN + IF(D%LGRIDONLY) THEN + CALL ABORT_TRANS('ETRANS_INQ: KNVALUE REQUIRED BUT LGRIDONLY=T') + ENDIF + IF(SIZE(KMVALUE) < D%NSPEC2) THEN + CALL ABORT_TRANS('ETRANS_INQ: KMVALUE TOO SMALL') + ELSE + CALL ELLIPS(R%NSMAX,RALD%NMSMAX,ISNAX,ISMAX) + DO JM=0,RALD%NMSMAX + ICPLM(JM) = 1*(ISNAX(JM)+1) + ENDDO + IC=1 + DO JMLOC=1,D%NUMP + IM=D%MYMS(JMLOC) + DO JN=0,ICPLM(IM)-1 + DO JJ=0,3 + KMVALUE(IC+JJ)=IM + ENDDO + IC=IC+4 + ENDDO + ENDDO + ENDIF +ENDIF + +IF(PRESENT(KCPL4M)) THEN + IF(D%LGRIDONLY) THEN + CALL ABORT_TRANS('ETRANS_INQ: KCPL4M REQUIRED BUT LGRIDONLY=T') + ENDIF + IF(UBOUND(KCPL4M,1) < RALD%NMSMAX) THEN + CALL ABORT_TRANS('ETRANS_INQ: KCPL4M TOO SMALL') + ELSE + CALL ELLIPS(R%NSMAX,RALD%NMSMAX,ISNAX,ISMAX) + DO JM=0,RALD%NMSMAX + KCPL4M(JM) = 4*(ISNAX(JM)+1) + ENDDO + ENDIF +ENDIF + + +IF(PRESENT(LDLINEAR_GRID)) THEN + LDLINEAR_GRID = R%NSMAX > (R%NDGL -1)/3 .OR. RALD%NMSMAX > (R%NDLON -1)/3 +ENDIF + + +IF (LHOOK) CALL DR_HOOK('ETRANS_INQ',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +!endif INTERFACE + +END SUBROUTINE ETRANS_INQ diff --git a/src/etrans/etrans/external/etrans_release.F90 b/src/etrans/etrans/external/etrans_release.F90 new file mode 100644 index 000000000..ea4f5a8a2 --- /dev/null +++ b/src/etrans/etrans/external/etrans_release.F90 @@ -0,0 +1,51 @@ +SUBROUTINE ETRANS_RELEASE(KRESOL) + +!**** *ETRANS_RELEASE* - release a spectral resolution + +! Purpose. +! -------- +! Release all arrays related to a given resolution tag + +!** Interface. +! ---------- +! CALL ETRANS_RELEASE + +! Explicit arguments : KRESOL : resolution tag +! -------------------- + +! Method. +! ------- + +! Externals. None +! ---------- + +! Author. +! ------- +! R. El Khatib *METEO-FRANCE* + +! Modifications. +! -------------- +! Original : 09-Jul-2013 + +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM + +!ifndef INTERFACE + +USE EDEALLOC_RESOL_MOD ,ONLY : EDEALLOC_RESOL +! + +IMPLICIT NONE + +INTEGER(KIND=JPIM),INTENT(IN) :: KRESOL + +!endif INTERFACE + +! ------------------------------------------------------------------ + +CALL EDEALLOC_RESOL(KRESOL) + +! ------------------------------------------------------------------ + +END SUBROUTINE ETRANS_RELEASE diff --git a/src/etrans/etrans/include/edir_trans.h b/src/etrans/etrans/include/edir_trans.h new file mode 100644 index 000000000..6f9721723 --- /dev/null +++ b/src/etrans/etrans/include/edir_trans.h @@ -0,0 +1,135 @@ +INTERFACE +SUBROUTINE EDIR_TRANS(PSPVOR,PSPDIV,PSPSCALAR,PSPSC3A,PSPSC3B,PSPSC2,& +& KPROMA,KVSETUV,KVSETSC,KRESOL,KVSETSC3A,KVSETSC3B,KVSETSC2,& +& PGP,PGPUV,PGP3A,PGP3B,PGP2,PMEANU,PMEANV,AUX_PROC) + + +!**** *EDIR_TRANS* - Direct spectral transform (from grid-point to spectral). + +! Purpose. +! -------- +! Interface routine for the direct spectral transform + +!** Interface. +! ---------- +! CALL EDIR_TRANS(...) + +! Explicit arguments : All arguments except from PGP are optional. +! -------------------- +! PSPVOR(:,:) - spectral vorticity (output) +! PSPDIV(:,:) - spectral divergence (output) +! PSPSCALAR(:,:) - spectral scalarvalued fields (output) +! PSPSC3A(:,:,:) - alternative to use of PSPSCALAR, see PGP3A below (input) +! PSPSC3B(:,:,:) - alternative to use of PSPSCALAR, see PGP3B below (input) +! PSPSC2(:,:) - alternative to use of PSPSCALAR, see PGP2 below (input) +! KPROMA - required blocking factor for gridpoint output +! KVSETUV(:) - indicating which 'b-set' in spectral space owns a +! vor/div field. Equivalant to NBSETLEV in the IFS. +! The length of KVSETUV should be the GLOBAL number +! of u/v fields which is the dimension of u and v releated +! fields in grid-point space. +! KVESETSC(:) - indicating which 'b-set' in spectral space owns a +! scalar field. As for KVSETUV this argument is required +! if the total number of processors is greater than +! the number of processors used for distribution in +! spectral wave space. +! KVSETSC3A(:) - as KVESETSC for PSPSC3A (distribution on first dimension) +! KVSETSC3B(:) - as KVESETSC for PSPSC3B (distribution on first dimension) +! KVSETSC2(:) - as KVESETSC for PSPSC2 (distribution on first dimension) +! KRESOL - resolution tag which is required ,default is the +! first defined resulution (input) +! PGP(:,:,:) - gridpoint fields (input) +! PGP need to dimensioned (NPROMA,IF_GP,NGPBLKS) where +! NPROMA is the blocking factor, IF_GP the total number +! of output fields and NGPBLKS the number of NPROMA blocks. +! The ordering of the output fields is as follows (all +! parts are optional depending on the input switches): +! +! u : IF_UV_G fields (if psvor present) +! v : IF_UV_G fields (if psvor present) +! scalar fields : IF_SCALARS_G fields (if pspscalar present) +! +! Here IF_UV_G is the GLOBAL number of u/v fields as given by the length +! of KVSETUV (or by PSPVOR if no split in spectral 'b-set' direction +! IF_SCALARS_G is the GLOBAL number of scalar fields as giben by the +! length of KVESETSC (or by number of fields in PSPSCALAR if no spectral +! 'b-set' split + +! As an alternative to using PGP you can also use a combination of the +! following arrays. The reason for introducing these alternative ways +! of calling DIR_TRANS is to avoid uneccessary copies where your data +! structures don't fit in to the 'PSPVOR,PSPDIV, PSPSCALAR, PGP' layout. +! The use of any of these precludes the use of PGP and vice versa. + +! PGPUV(:,:,:,:) - the 'u-v' related grid-point variables in the order +! described for PGP. The second dimension of PGPUV should +! be the same as the "global" first dimension of +! PSPVOR,PSPDIV (in the IFS this is the number of levels) +! PGPUV need to be dimensioned(NPROMA,ILEVS,IFLDS,NGPBLKS) +! IFLDS is the number of 'variables' (u,v) +! PGP3A(:,:,:,:) - grid-point array directly connected with PSPSC3A +! dimensioned(NPROMA,ILEVS,IFLDS,NGPBLKS) +! IFLDS is the number of 'variables' (the same as in +! PSPSC3A ) +! PGP3B(:,:,:,:) - grid-point array directly connected with PSPSC3B +! dimensioned(NPROMA,ILEVS,IFLDS,NGPBLKS) +! IFLDS is the number of 'variables' (the same as in +! PSPSC3B) +! PGP2(:,:,:) - grid-point array directly connected with PSPSC2 +! dimensioned(NPROMA,IFLDS,NGPBLKS) +! IFLDS is the number of 'variables' (the same as in +! PSPSC2 ) +! PMEANU(:),PMEANV(:) - mean wind +! AUX_PROC - optional external procedure for biperiodization of +! aux.fields + +! Method. +! ------- + +! Externals. SET_RESOL - set resolution +! ---------- LTDIR_CTL - control of Legendre transform +! FTDIR_CTL - control of Fourier transform + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-03-03 + +! ------------------------------------------------------------------ +USE PARKIND1 ,ONLY : JPIM ,JPRB + +IMPLICIT NONE + +! Declaration of arguments + +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPVOR(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPDIV(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPSCALAR(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPSC3A(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPSC3B(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPSC2(:,:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KPROMA +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETUV(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC3A(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC3B(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC2(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KRESOL + +REAL(KIND=JPRB),OPTIONAL ,INTENT(IN) :: PGP(:,:,:) +REAL(KIND=JPRB),OPTIONAL ,INTENT(IN) :: PGPUV(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL ,INTENT(IN) :: PGP3A(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL ,INTENT(IN) :: PGP3B(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL ,INTENT(IN) :: PGP2(:,:,:) +REAL(KIND=JPRB),OPTIONAL ,INTENT(OUT) :: PMEANU(:) +REAL(KIND=JPRB),OPTIONAL ,INTENT(OUT) :: PMEANV(:) +EXTERNAL AUX_PROC +OPTIONAL AUX_PROC + + +END SUBROUTINE EDIR_TRANS + +END INTERFACE diff --git a/src/etrans/etrans/include/edir_transad.h b/src/etrans/etrans/include/edir_transad.h new file mode 100644 index 000000000..7dc6fa0d3 --- /dev/null +++ b/src/etrans/etrans/include/edir_transad.h @@ -0,0 +1,131 @@ +INTERFACE +SUBROUTINE EDIR_TRANSAD(PSPVOR,PSPDIV,PSPSCALAR,PSPSC3A,PSPSC3B,PSPSC2,& +& KPROMA,KVSETUV,KVSETSC,KRESOL,KVSETSC3A,KVSETSC3B,KVSETSC2,& +& PGP,PGPUV,PGP3A,PGP3B,PGP2,PMEANU,PMEANV) + + +!**** *EDIR_TRANSAD* - Direct spectral transform - adjoint. + +! Purpose. +! -------- +! Interface routine for the direct spectral transform - adjoint + +!** Interface. +! ---------- +! CALL EDIR_TRANSAD(...) + +! Explicit arguments : All arguments except from PGP are optional. +! -------------------- +! PSPVOR(:,:) - spectral vorticity (output) +! PSPDIV(:,:) - spectral divergence (output) +! PSPSCALAR(:,:) - spectral scalarvalued fields (output) +! PSPSC3A(:,:,:) - alternative to use of PSPSCALAR, see PGP3A below (input) +! PSPSC3B(:,:,:) - alternative to use of PSPSCALAR, see PGP3B below (input) +! PSPSC2(:,:) - alternative to use of PSPSCALAR, see PGP2 below (input) +! KPROMA - required blocking factor for gridpoint output +! KVSETUV(:) - indicating which 'b-set' in spectral space owns a +! vor/div field. Equivalant to NBSETLEV in the IFS. +! The length of KVSETUV should be the GLOBAL number +! of u/v fields which is the dimension of u and v releated +! fields in grid-point space. +! KVESETSC(:) - indicating which 'b-set' in spectral space owns a +! scalar field. As for KVSETUV this argument is required +! if the total number of processors is greater than +! the number of processors used for distribution in +! spectral wave space. +! KVSETSC3A(:) - as KVESETSC for PSPSC3A (distribution on first dimension) +! KVSETSC3B(:) - as KVESETSC for PSPSC3B (distribution on first dimension) +! KVSETSC2(:) - as KVESETSC for PSPSC2 (distribution on first dimension) +! KRESOL - resolution tag which is required ,default is the +! first defined resulution (input) +! PGP(:,:,:) - gridpoint fields (input) +! PGP need to dimensioned (NPROMA,IF_GP,NGPBLKS) where +! NPROMA is the blocking factor, IF_GP the total number +! of output fields and NGPBLKS the number of NPROMA blocks. +! The ordering of the output fields is as follows (all +! parts are optional depending on the input switches): +! +! u : IF_UV_G fields (if psvor present) +! v : IF_UV_G fields (if psvor present) +! scalar fields : IF_SCALARS_G fields (if pspscalar present) +! +! Here IF_UV_G is the GLOBAL number of u/v fields as given by the length +! of KVSETUV (or by PSPVOR if no split in spectral 'b-set' direction +! IF_SCALARS_G is the GLOBAL number of scalar fields as giben by the +! length of KVESETSC (or by number of fields in PSPSCALAR if no spectral +! 'b-set' split +! +! As an alternative to using PGP you can also use a combination of the +! following arrays. The reason for introducing these alternative ways +! of calling DIR_TRANS is to avoid uneccessary copies where your data +! structures don't fit in to the 'PSPVOR,PSPDIV, PSPSCALAR, PGP' layout. +! The use of any of these precludes the use of PGP and vice versa. + +! PGPUV(:,:,:,:) - the 'u-v' related grid-point variables in the order +! described for PGP. The second dimension of PGPUV should +! be the same as the "global" first dimension of +! PSPVOR,PSPDIV (in the IFS this is the number of levels) +! PGPUV need to be dimensioned(NPROMA,ILEVS,IFLDS,NGPBLKS) +! IFLDS is the number of 'variables' (u,v) +! PGP3A(:,:,:,:) - grid-point array directly connected with PSPSC3A +! dimensioned(NPROMA,ILEVS,IFLDS,NGPBLKS) +! IFLDS is the number of 'variables' (the same as in +! PSPSC3A ) +! PGP3B(:,:,:,:) - grid-point array directly connected with PSPSC3B +! dimensioned(NPROMA,ILEVS,IFLDS,NGPBLKS) +! IFLDS is the number of 'variables' (the same as in +! PSPSC3B) +! PGP2(:,:,:) - grid-point array directly connected with PSPSC2 +! dimensioned(NPROMA,IFLDS,NGPBLKS) +! IFLDS is the number of 'variables' (the same as in +! PSPSC2 ) +! +! Method. +! ------- + +! Externals. ESET_RESOL - set resolution +! ---------- EDIR_TRANS_CTLAD - control routine +! + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-03-03 + +! ------------------------------------------------------------------ +USE PARKIND1 ,ONLY : JPIM ,JPRB + +IMPLICIT NONE + +! Declaration of arguments + +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPVOR(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPDIV(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPSCALAR(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPSC3A(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPSC3B(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPSC2(:,:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KPROMA +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETUV(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC3A(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC3B(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC2(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KRESOL + +REAL(KIND=JPRB),OPTIONAL ,INTENT(OUT) :: PGP(:,:,:) +REAL(KIND=JPRB),OPTIONAL ,INTENT(OUT) :: PGPUV(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL ,INTENT(OUT) :: PGP3A(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL ,INTENT(OUT) :: PGP3B(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL ,INTENT(OUT) :: PGP2(:,:,:) +REAL(KIND=JPRB),OPTIONAL ,INTENT(IN) :: PMEANU(:) +REAL(KIND=JPRB),OPTIONAL ,INTENT(IN) :: PMEANV(:) + + +END SUBROUTINE EDIR_TRANSAD + + +END INTERFACE diff --git a/src/etrans/etrans/include/edist_grid.h b/src/etrans/etrans/include/edist_grid.h new file mode 100644 index 000000000..92e93aeb7 --- /dev/null +++ b/src/etrans/etrans/include/edist_grid.h @@ -0,0 +1,57 @@ +INTERFACE +SUBROUTINE EDIST_GRID(PGPG,KPROMA,KFDISTG,KFROM,KRESOL,PGP,KSORT) + +!**** *EDIST_GRID* - Distribute global gridpoint array among processors + +! Purpose. +! -------- +! Interface routine for distributing gridpoint array + +!** Interface. +! ---------- +! CALL EDIST_GRID(...) + +! Explicit arguments : +! -------------------- +! PGPG(:,:) - Global spectral array +! KFDISTG - Global number of fields to be distributed +! KPROMA - required blocking factor for gridpoint input +! KFROM(:) - Processor resposible for distributing each field +! KRESOL - resolution tag which is required ,default is the +! first defined resulution (input) +! PGP(:,:) - Local spectral array +! +! Method. +! ------- + +! Externals. ESET_RESOL - set resolution +! ---------- DIST_GRID_CTL - control routine + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-03-03 + +! ------------------------------------------------------------------ +USE PARKIND1 ,ONLY : JPIM ,JPRB + +IMPLICIT NONE + +! Declaration of arguments + +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PGPG(:,:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KPROMA +INTEGER(KIND=JPIM) , INTENT(IN) :: KFDISTG +INTEGER(KIND=JPIM) , INTENT(IN) :: KFROM(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KRESOL +REAL(KIND=JPRB) , INTENT(OUT) :: PGP(:,:,:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KSORT (:) + + +! ------------------------------------------------------------------ + +END SUBROUTINE EDIST_GRID +END INTERFACE diff --git a/src/etrans/etrans/include/edist_spec.h b/src/etrans/etrans/include/edist_spec.h new file mode 100644 index 000000000..43b9b4bcf --- /dev/null +++ b/src/etrans/etrans/include/edist_spec.h @@ -0,0 +1,59 @@ +INTERFACE +SUBROUTINE EDIST_SPEC(PSPECG,KFDISTG,KFROM,KVSET,KRESOL,PSPEC,& + & LDIM1_IS_FLD,KSORT) + +!**** *EDIST_SPEC* - Distribute global spectral array among processors + +! Purpose. +! -------- +! Interface routine for distributing spectral array + +!** Interface. +! ---------- +! CALL EDIST__SPEC(...) + +! Explicit arguments : +! -------------------- +! PSPECG(:,:) - Global spectral array +! KFDISTG - Global number of fields to be distributed +! KFROM(:) - Processor resposible for distributing each field +! KVSET(:) - "B-Set" for each field +! KRESOL - resolution tag which is required ,default is the +! first defined resulution (input) +! PSPEC(:,:) - Local spectral array +! +! Method. +! ------- + +! Externals. ESET_RESOL - set resolution +! ---------- EDIST_SPEC_CONTROL - control routine + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-03-03 + +! ------------------------------------------------------------------ +USE PARKIND1 ,ONLY : JPIM ,JPRB + +IMPLICIT NONE + +! Declaration of arguments + +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPECG(:,:) +INTEGER(KIND=JPIM) , INTENT(IN) :: KFDISTG +INTEGER(KIND=JPIM) , INTENT(IN) :: KFROM(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSET(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KRESOL +LOGICAL ,OPTIONAL, INTENT(IN) :: LDIM1_IS_FLD +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPEC(:,:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KSORT (:) + + +! ------------------------------------------------------------------ + +END SUBROUTINE EDIST_SPEC +END INTERFACE diff --git a/src/etrans/etrans/include/egath_grid.h b/src/etrans/etrans/include/egath_grid.h new file mode 100644 index 000000000..a9742c300 --- /dev/null +++ b/src/etrans/etrans/include/egath_grid.h @@ -0,0 +1,56 @@ +INTERFACE +SUBROUTINE EGATH_GRID(PGPG,KPROMA,KFGATHG,KTO,KRESOL,PGP) + +!**** *EGATH_GRID* - Gather global gridpoint array from processors + +! Purpose. +! -------- +! Interface routine for gathering gripoint array + +!** Interface. +! ---------- +! CALL EGATH_GRID(...) + +! Explicit arguments : +! -------------------- +! PGPG(:,:) - Global gridpoint array +! KFGATHG - Global number of fields to be gathered +! KPROMA - blocking factor for gridpoint input +! KTO(:) - Processor responsible for gathering each field +! KRESOL - resolution tag which is required ,default is the +! first defined resulution (input) +! PGP(:,:,:) - Local spectral array +! +! Method. +! ------- + +! Externals. ESET_RESOL - set resolution +! ---------- GATH_GRID_CTL - control routine + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-03-03 + +! ------------------------------------------------------------------ +USE PARKIND1 ,ONLY : JPIM ,JPRB + +IMPLICIT NONE + +! Declaration of arguments + +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PGPG(:,:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KPROMA +INTEGER(KIND=JPIM) , INTENT(IN) :: KFGATHG +INTEGER(KIND=JPIM) , INTENT(IN) :: KTO(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KRESOL +REAL(KIND=JPRB) , INTENT(IN) :: PGP(:,:,:) + + +! ------------------------------------------------------------------ + +END SUBROUTINE EGATH_GRID +END INTERFACE diff --git a/src/etrans/etrans/include/egath_spec.h b/src/etrans/etrans/include/egath_spec.h new file mode 100644 index 000000000..5a2842d0b --- /dev/null +++ b/src/etrans/etrans/include/egath_spec.h @@ -0,0 +1,64 @@ +INTERFACE +SUBROUTINE EGATH_SPEC(PSPECG,KFGATHG,KTO,KVSET,KRESOL,PSPEC,LDIM1_IS_FLD,KSMAX,KMSMAX,LDZA0IP) + +!**** *EGATH_SPEC* - Gather global spectral array from processors + +! Purpose. +! -------- +! Interface routine for gathering spectral array + +!** Interface. +! ---------- +! CALL EGATH_SPEC(...) + +! Explicit arguments : +! -------------------- +! PSPECG(:,:) - Global spectral array +! KFGATHG - Global number of fields to be gathered +! KTO(:) - Processor responsible for gathering each field +! KVSET(:) - "B-Set" for each field +! KRESOL - resolution tag which is required ,default is the +! first defined resulution (input) +! PSPEC(:,:) - Local spectral array +! LDIM1_IS_FLD - If TRUE first dimension of PSCPEC and PSPECG is the field dimension [.T.] +! +! Method. +! ------- + +! Externals. SET_RESOL - set resolution +! ---------- EGATH_SPEC_CONTROL - control routine + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-03-03 + +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB + + +IMPLICIT NONE + +! Declaration of arguments + +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPECG(:,:) +INTEGER(KIND=JPIM) , INTENT(IN) :: KFGATHG +INTEGER(KIND=JPIM) , INTENT(IN) :: KTO(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSET(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KRESOL +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPEC(:,:) +LOGICAL ,OPTIONAL, INTENT(IN) :: LDIM1_IS_FLD +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KSMAX +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KMSMAX +LOGICAL ,OPTIONAL, INTENT(IN) :: LDZA0IP + + +! ------------------------------------------------------------------ + +END SUBROUTINE EGATH_SPEC + +END INTERFACE diff --git a/src/etrans/etrans/include/egpnorm_trans.h b/src/etrans/etrans/include/egpnorm_trans.h new file mode 100644 index 000000000..8c7fc4e53 --- /dev/null +++ b/src/etrans/etrans/include/egpnorm_trans.h @@ -0,0 +1,59 @@ +INTERFACE +SUBROUTINE EGPNORM_TRANS(PGP,KFIELDS,KPROMA,PAVE,PMIN,PMAX,LDAVE_ONLY,KRESOL) + + +!**** *EGPNORM_TRANS* - calculate grid-point norms + +! Purpose. +! -------- +! calculate grid-point norms using a 2 stage (NPRTRV,NPRTRW) communication rather +! than an approach using a more expensive global gather collective communication + +!** Interface. +! ---------- +! CALL EGPNORM_TRANS(...) + +! Explicit arguments : +! -------------------- +! PGP(:,:,:) - gridpoint fields (input) +! PGP is dimensioned (NPROMA,KFIELDS,NGPBLKS) where +! NPROMA is the blocking factor, KFIELDS the total number +! of fields and NGPBLKS the number of NPROMA blocks. +! KFIELDS - number of fields (input) +! (these do not have to be just levels) +! KPROMA - required blocking factor (input) +! PAVE - average (output) +! PMIN - minimum (input/output) +! PMAX - maximum (input/output) +! LDAVE_ONLY - T : PMIN and PMAX already contain local MIN and MAX +! KRESOL - resolution tag (optional) +! default assumes first defined resolution +! + +! Author. +! ------- +! A.Bogatchev after gpnorm_trans + +! Modifications. +! -------------- +! Original : 12th Jun 2009 + +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB + +IMPLICIT NONE + +! Declaration of arguments + +REAL(KIND=JPRB),INTENT(IN) :: PGP(:,:,:) +REAL(KIND=JPRB),INTENT(OUT) :: PAVE(:) +REAL(KIND=JPRB),INTENT(INOUT) :: PMIN(:) +REAL(KIND=JPRB),INTENT(INOUT) :: PMAX(:) +INTEGER(KIND=JPIM),INTENT(IN) :: KFIELDS +INTEGER(KIND=JPIM),INTENT(IN) :: KPROMA +LOGICAL,INTENT(IN) :: LDAVE_ONLY +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KRESOL + +END SUBROUTINE EGPNORM_TRANS +END INTERFACE diff --git a/src/etrans/etrans/include/einv_trans.h b/src/etrans/etrans/include/einv_trans.h new file mode 100644 index 000000000..143d883b8 --- /dev/null +++ b/src/etrans/etrans/include/einv_trans.h @@ -0,0 +1,151 @@ +INTERFACE +SUBROUTINE EINV_TRANS(PSPVOR,PSPDIV,PSPSCALAR,PSPSC3A,PSPSC3B,PSPSC2,& + & FSPGL_PROC,& + & LDSCDERS,LDVORGP,LDDIVGP,LDUVDER,KPROMA,KVSETUV,KVSETSC,KRESOL,& + & KVSETSC3A,KVSETSC3B,KVSETSC2,& + & PGP,PGPUV,PGP3A,PGP3B,PGP2,PMEANU,PMEANV) + +!**** *EINV_TRANS* - Inverse spectral transform. + +! Purpose. +! -------- +! Interface routine for the inverse spectral transform + +!** Interface. +! ---------- +! CALL EINV_TRANS(...) + +! Explicit arguments : All arguments are optional. +! -------------------- +! PSPVOR(:,:) - spectral vorticity (input) +! PSPDIV(:,:) - spectral divergence (input) +! PSPSCALAR(:,:) - spectral scalarvalued fields (input) +! PSPSC3A(:,:,:) - alternative to use of PSPSCALAR, see PGP3A below (input) +! PSPSC3B(:,:,:) - alternative to use of PSPSCALAR, see PGP3B below (input) +! PSPSC2(:,:) - alternative to use of PSPSCALAR, see PGP2 below (input) +! FSPGL_PROC - external procedure to be executed in fourier space +! before transposition +! LDSCDERS - indicating if derivatives of scalar variables are req. +! LDVORGP - indicating if grid-point vorticity is req. +! LDDIVGP - indicating if grid-point divergence is req. +! LDUVDER - indicating if E-W derivatives of u and v are req. +! KPROMA - required blocking factor for gridpoint output +! KVSETUV(:) - indicating which 'b-set' in spectral space owns a +! vor/div field. Equivalant to NBSETLEV in the IFS. +! The length of KVSETUV should be the GLOBAL number +! of u/v fields which is the dimension of u and v releated +! fields in grid-point space. +! KVESETSC(:) - indicating which 'b-set' in spectral space owns a +! scalar field. As for KVSETUV this argument is required +! if the total number of processors is greater than +! the number of processors used for distribution in +! spectral wave space. +! KVSETSC3A(:) - as KVESETSC for PSPSC3A (distribution on first dimension) +! KVSETSC3B(:) - as KVESETSC for PSPSC3B (distribution on first dimension) +! KVSETSC2(:) - as KVESETSC for PSPSC2 (distribution on first dimension) +! KRESOL - resolution tag which is required ,default is the +! first defined resulution (input) +! PGP(:,:,:) - gridpoint fields (output) +! PGP need to dimensioned (NPROMA,IF_GP,NGPBLKS) where +! NPROMA is the blocking factor, IF_GP the total number +! of output fields and NGPBLKS the number of NPROMA blocks. +! The ordering of the output fields is as follows (all +! parts are optional depending on the input switches): +! +! vorticity : IF_UV_G fields (if psvor present and LDVORGP) +! divergence : IF_UV_G fields (if psvor present and LDDIVGP) +! u : IF_UV_G fields (if psvor present) +! v : IF_UV_G fields (if psvor present) +! scalar fields : IF_SCALARS_G fields (if pspscalar present) +! N-S derivative of scalar fields : IF_SCALARS_G fields (if pspscalar +! present and LDSCDERS) +! E-W derivative of u : IF_UV_G fields (if psvor present and and LDUVDER) +! E-W derivative of v : IF_UV_G fields (if psvor present and and LDUVDER) +! E-W derivative of scalar fields : IF_SCALARS_G fields (if pspscalar +! present and LDSCDERS) +! +! Here IF_UV_G is the GLOBAL number of u/v fields as given by the length +! of KVSETUV (or by PSPVOR if no split in spectral 'b-set' direction +! IF_SCALARS_G is the GLOBAL number of scalar fields as giben by the +! length of KVESETSC (or by number of fields in PSPSCALAR if no spectral +! 'b-set' split + +! As an alternative to using PGP you can also use a combination of the +! following arrays. The reason for introducing these alternative ways +! of calling INV_TRANS is to avoid uneccessary copies where your data +! structures don't fit in to the 'PSPVOR,PSPDIV, PSPSCALAR, PGP' layout. +! The use of any of these precludes the use of PGP and vice versa. + +! PGPUV(:,:,:,:) - the 'u-v' related grid-point variables in the order +! described for PGP. The second dimension of PGPUV should +! be the same as the "global" first dimension of +! PSPVOR,PSPDIV (in the IFS this is the number of levels) +! PGPUV need to be dimensioned(NPROMA,ILEVS,IFLDS,NGPBLKS) +! IFLDS is the number of 'variables' (u,v,vor,div ...) +! PGP3A(:,:,:,:) - grid-point array directly connected with PSPSC3A +! dimensioned(NPROMA,ILEVS,IFLDS,NGPBLKS) +! IFLDS is the number of 'variables' (the same as in +! PSPSC3A if no derivatives, 3 times that with der.) +! PGP3B(:,:,:,:) - grid-point array directly connected with PSPSC3B +! dimensioned(NPROMA,ILEVS,IFLDS,NGPBLKS) +! IFLDS is the number of 'variables' (the same as in +! PSPSC3B if no derivatives, 3 times that with der.) +! PGP2(:,:,:) - grid-point array directly connected with PSPSC2 +! dimensioned(NPROMA,IFLDS,NGPBLKS) +! IFLDS is the number of 'variables' (the same as in +! PSPSC2 if no derivatives, 3 times that with der.) +! Method. +! ------- + +! Externals. ESET_RESOL - set resolution +! ---------- ELTINV_CTL - control of Legendre transform +! EFTINV_CTL - control of Fourier transform + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-03-03 +! 26-02-03 Mats Hamrud & Gabor Radnoti : modified condition for scalar fields +! and derivatives (IF_SCALARS_G) + +! ------------------------------------------------------------------ +USE PARKIND1 ,ONLY : JPIM ,JPRB + +IMPLICIT NONE + +! Declaration of arguments + +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPVOR(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPDIV(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPSCALAR(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPSC3A(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPSC3B(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPSC2(:,:) +LOGICAL ,OPTIONAL, INTENT(IN) :: LDSCDERS +LOGICAL ,OPTIONAL, INTENT(IN) :: LDVORGP +LOGICAL ,OPTIONAL, INTENT(IN) :: LDDIVGP +LOGICAL ,OPTIONAL, INTENT(IN) :: LDUVDER +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KPROMA +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETUV(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC3A(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC3B(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC2(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KRESOL +EXTERNAL FSPGL_PROC +OPTIONAL FSPGL_PROC +REAL(KIND=JPRB),OPTIONAL ,INTENT(OUT) :: PGP(:,:,:) +REAL(KIND=JPRB),OPTIONAL ,INTENT(OUT) :: PGPUV(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL ,INTENT(OUT) :: PGP3A(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL ,INTENT(OUT) :: PGP3B(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL ,INTENT(OUT) :: PGP2(:,:,:) +REAL(KIND=JPRB),OPTIONAL ,INTENT(IN) :: PMEANU(:) +REAL(KIND=JPRB),OPTIONAL ,INTENT(IN) :: PMEANV(:) + + +END SUBROUTINE EINV_TRANS + +END INTERFACE diff --git a/src/etrans/etrans/include/einv_transad.h b/src/etrans/etrans/include/einv_transad.h new file mode 100644 index 000000000..923864915 --- /dev/null +++ b/src/etrans/etrans/include/einv_transad.h @@ -0,0 +1,150 @@ +INTERFACE +SUBROUTINE EINV_TRANSAD(PSPVOR,PSPDIV,PSPSCALAR,PSPSC3A,PSPSC3B,PSPSC2,& + & FSPGL_PROC,& + & LDSCDERS,LDVORGP,LDDIVGP,LDUVDER,KPROMA,KVSETUV,KVSETSC,KRESOL,& + & KVSETSC3A,KVSETSC3B,KVSETSC2,& + & PGP,PGPUV,PGP3A,PGP3B,PGP2,PMEANU,PMEANV) + +!**** *EINV_TRANSAD* - Inverse spectral transform - adjoint. + +! Purpose. +! -------- +! Interface routine for the inverse spectral transform - adjoint + +!** Interface. +! ---------- +! CALL EINV_TRANSAD(...) + +! Explicit arguments : All arguments except from PGP are optional. +! -------------------- +! PSPVOR(:,:) - spectral vorticity (input) +! PSPDIV(:,:) - spectral divergence (input) +! PSPSCALAR(:,:) - spectral scalarvalued fields (input) +! PSPSC3A(:,:,:) - alternative to use of PSPSCALAR, see PGP3A below (input) +! PSPSC3B(:,:,:) - alternative to use of PSPSCALAR, see PGP3B below (input) +! PSPSC2(:,:) - alternative to use of PSPSCALAR, see PGP2 below (input) +! FSPGL_PROC - external procedure to be executed in fourier space +! before transposition +! LDSCDERS - indicating if derivatives of scalar variables are req. +! LDVORGP - indicating if grid-point vorticity is req. +! LDDIVGP - indicating if grid-point divergence is req. +! LDUVDER - indicating if E-W derivatives of u and v are req. +! KPROMA - required blocking factor for gridpoint output +! KVSETUV(:) - indicating which 'b-set' in spectral space owns a +! vor/div field. Equivalant to NBSETLEV in the IFS. +! The length of KVSETUV should be the GLOBAL number +! of u/v fields which is the dimension of u and v releated +! fields in grid-point space. +! KVESETSC(:) - indicating which 'b-set' in spectral space owns a +! scalar field. As for KVSETUV this argument is required +! if the total number of processors is greater than +! the number of processors used for distribution in +! spectral wave space. +! KVSETSC3A(:) - as KVESETSC for PSPSC3A (distribution on first dimension) +! KVSETSC3B(:) - as KVESETSC for PSPSC3B (distribution on first dimension) +! KVSETSC2(:) - as KVESETSC for PSPSC2 (distribution on first dimension) +! KRESOL - resolution tag which is required ,default is the +! first defined resulution (input) +! PGP(:,:,:) - gridpoint fields (output) +! PGP need to dimensioned (NPROMA,IF_GP,NGPBLKS) where +! NPROMA is the blocking factor, IF_GP the total number +! of output fields and NGPBLKS the number of NPROMA blocks. +! The ordering of the output fields is as follows (all +! parts are optional depending on the input switches): +! +! vorticity : IF_UV_G fields (if psvor present and LDVORGP) +! divergence : IF_UV_G fields (if psvor present and LDDIVGP) +! u : IF_UV_G fields (if psvor present) +! v : IF_UV_G fields (if psvor present) +! scalar fields : IF_SCALARS_G fields (if pspscalar present) +! N-S derivative of scalar fields : IF_SCALARS_G fields (if pspscalar +! present and LDSCDERS) +! E-W derivative of u : IF_UV_G fields (if psvor present and and LDUVDER) +! E-W derivative of v : IF_UV_G fields (if psvor present and and LDUVDER) +! E-W derivative of scalar fields : IF_SCALARS_G fields (if pspscalar +! present and LDSCDERS) +! +! Here IF_UV_G is the GLOBAL number of u/v fields as given by the length +! of KVSETUV (or by PSPVOR if no split in spectral 'b-set' direction +! IF_SCALARS_G is the GLOBAL number of scalar fields as giben by the +! length of KVESETSC (or by number of fields in PSPSCALAR if no spectral +! 'b-set' split + +! As an alternative to using PGP you can also use a combination of the +! following arrays. The reason for introducing these alternative ways +! of calling INV_TRANS is to avoid uneccessary copies where your data +! structures don't fit in to the 'PSPVOR,PSPDIV, PSPSCALAR, PGP' layout. +! The use of any of these precludes the use of PGP and vice versa. +! +! PGPUV(:,:,:,:) - the 'u-v' related grid-point variables in the order +! described for PGP. The second dimension of PGPUV should +! be the same as the "global" first dimension of +! PSPVOR,PSPDIV (in the IFS this is the number of levels) +! PGPUV need to be dimensioned(NPROMA,ILEVS,IFLDS,NGPBLKS) +! IFLDS is the number of 'variables' (u,v,vor,div ...) +! PGP3A(:,:,:,:) - grid-point array directly connected with PSPSC3A +! dimensioned(NPROMA,ILEVS,IFLDS,NGPBLKS) +! IFLDS is the number of 'variables' (the same as in +! PSPSC3A if no derivatives, 3 times that with der.) +! PGP3B(:,:,:,:) - grid-point array directly connected with PSPSC3B +! dimensioned(NPROMA,ILEVS,IFLDS,NGPBLKS) +! IFLDS is the number of 'variables' (the same as in +! PSPSC3B if no derivatives, 3 times that with der.) +! PGP2(:,:,:) - grid-point array directly connected with PSPSC2 +! dimensioned(NPROMA,IFLDS,NGPBLKS) +! IFLDS is the number of 'variables' (the same as in +! PSPSC2 if no derivatives, 3 times that with der.) + +! Method. +! ------- + +! Externals. ESET_RESOL - set resolution +! ---------- ELTDIR_CTLAD - control of Legendre transform +! EFTDIR_CTLAD - control of Fourier transform + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-03-03 + +! ------------------------------------------------------------------ +USE PARKIND1 ,ONLY : JPIM ,JPRB + +IMPLICIT NONE + +! Declaration of arguments + +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPVOR(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPDIV(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPSCALAR(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPSC3A(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPSC3B(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPSC2(:,:) +LOGICAL ,OPTIONAL, INTENT(IN) :: LDSCDERS +LOGICAL ,OPTIONAL, INTENT(IN) :: LDVORGP +LOGICAL ,OPTIONAL, INTENT(IN) :: LDDIVGP +LOGICAL ,OPTIONAL, INTENT(IN) :: LDUVDER +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KPROMA +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETUV(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC3A(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC3B(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC2(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KRESOL +EXTERNAL FSPGL_PROC +OPTIONAL FSPGL_PROC +REAL(KIND=JPRB),OPTIONAL ,INTENT(IN) :: PGP(:,:,:) +REAL(KIND=JPRB),OPTIONAL ,INTENT(IN) :: PGPUV(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL ,INTENT(IN) :: PGP3A(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL ,INTENT(IN) :: PGP3B(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL ,INTENT(IN) :: PGP2(:,:,:) +REAL(KIND=JPRB),OPTIONAL ,INTENT(OUT) :: PMEANU(:) +REAL(KIND=JPRB),OPTIONAL ,INTENT(OUT) :: PMEANV(:) + + +END SUBROUTINE EINV_TRANSAD + +END INTERFACE diff --git a/src/etrans/etrans/include/esetup_trans.h b/src/etrans/etrans/include/esetup_trans.h new file mode 100644 index 000000000..15c99f17c --- /dev/null +++ b/src/etrans/etrans/include/esetup_trans.h @@ -0,0 +1,88 @@ +INTERFACE +SUBROUTINE ESETUP_TRANS(KMSMAX,KSMAX,KDGL,KDGUX,KLOEN,LDSPLIT,& + & KTMAX,KRESOL,PEXWN,PEYWN,PWEIGHT,LDGRIDONLY,KNOEXTZL,KNOEXTZG,& + & LDUSEFFTW,LD_ALL_FFTW) +!**** *ESETUP_TRANS* - Setup transform package for specific resolution + +! Purpose. +! -------- +! To setup for making spectral transforms. Each call to this routine +! creates a new resolution up to a maximum of NMAX_RESOL set up in +! SETUP_TRANS0. You need to call SETUP_TRANS0 before this routine can +! be called. + +!** Interface. +! ---------- +! CALL ESETUP_TRANS(...) + +! Explicit arguments : KLOEN,LDSPLIT are optional arguments +! -------------------- +! KSMAX - spectral truncation required +! KDGL - number of Gaussian latitudes +! KLOEN(:) - number of points on each Gaussian latitude [2*KDGL] +! LDSPLIT - true if split latitudes in grid-point space [false] +! KTMAX - truncation order for tendencies? +! KRESOL - the resolution identifier +! KSMAX,KDGL,KTMAX and KLOEN are GLOBAL variables desribing the resolution +! in spectral and grid-point space +! LDGRIDONLY - true if only grid space is required + + +! LDSPLIT describe the distribution among processors of +! grid-point data and has no relevance if you are using a single processor + +! LDUSEFFTW - Use FFTW for FFTs +! LD_ALL_FFTW : T to transform all fields in one call, F to transforms fields one after another + +! Method. +! ------- + +! Externals. ESET_RESOL - set resolution +! ---------- ESETUP_DIMS - setup distribution independent dimensions +! SUEMP_TRANS_PRELEG - first part of setup of distr. environment +! SULEG - Compute Legandre polonomial and Gaussian +! Latitudes and Weights +! ESETUP_GEOM - Compute arrays related to grid-point geometry +! SUEMP_TRANS - Second part of setup of distributed environment +! SUEFFT - setup for FFT + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-03-03 +! 02-04-11 A. Bogatchev: Passing of TCDIS +! 02-11-14 C. Fischer: soften test on KDGL +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! A.Nmiri 15-Nov-2007 Phasing with TFL 32R3 +! A.Bogatchev 16-Sep-2010 Phasing cy37 +! D. Degrauwe (Feb 2012): Alternative extension zone (E') + +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB + +IMPLICIT NONE + +! Dummy arguments +INTEGER(KIND=JPIM),INTENT(IN) :: KMSMAX +INTEGER(KIND=JPIM),INTENT(IN) :: KSMAX +INTEGER(KIND=JPIM),INTENT(IN) :: KDGL +INTEGER(KIND=JPIM),INTENT(IN) :: KDGUX +INTEGER(KIND=JPIM),INTENT(IN) :: KLOEN(:) +LOGICAL ,OPTIONAL,INTENT(IN) :: LDSPLIT +LOGICAL ,OPTIONAL,INTENT(IN) :: LDGRIDONLY +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KTMAX +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KRESOL +REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PEXWN +REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PEYWN +REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PWEIGHT(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KNOEXTZL +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KNOEXTZG +LOGICAL ,OPTIONAL,INTENT(IN) :: LDUSEFFTW +LOGICAL ,OPTIONAL,INTENT(IN) :: LD_ALL_FFTW + +END SUBROUTINE ESETUP_TRANS +END INTERFACE diff --git a/src/etrans/etrans/include/especnorm.h b/src/etrans/etrans/include/especnorm.h new file mode 100644 index 000000000..7edf5d78c --- /dev/null +++ b/src/etrans/etrans/include/especnorm.h @@ -0,0 +1,56 @@ +INTERFACE +SUBROUTINE ESPECNORM(PSPEC,KVSET,KMASTER,KRESOL,PMET,PNORM) + +!**** *ESPECNORM* - Compute global spectral norms + +! Purpose. +! -------- +! Interface routine for computing spectral norms + +!** Interface. +! ---------- +! CALL ESPECNORM(...) + +! Explicit arguments : All arguments optional +! -------------------- +! PSPEC(:,:) - Spectral array +! KVSET(:) - "B-Set" for each field +! KMASTER - processor to recieve norms +! KRESOL - resolution tag which is required ,default is the +! first defined resulution (input) +! PMET(:) - metric +! PNORM(:) - Norms (output for processor KMASTER) +! +! Method. +! ------- + +! Externals. ESET_RESOL - set resolution +! ---------- ESPNORM_CTL - control routine + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-03-03 + +! ------------------------------------------------------------------ +USE PARKIND1 ,ONLY : JPIM ,JPRB + +IMPLICIT NONE + +! Declaration of arguments + + +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPEC(:,:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSET(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KMASTER +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PMET(:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PNORM(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KRESOL + +! ------------------------------------------------------------------ + +END SUBROUTINE ESPECNORM +END INTERFACE diff --git a/src/etrans/etrans/include/etrans_end.h b/src/etrans/etrans/include/etrans_end.h new file mode 100644 index 000000000..fb1090fb2 --- /dev/null +++ b/src/etrans/etrans/include/etrans_end.h @@ -0,0 +1,41 @@ +INTERFACE +SUBROUTINE ETRANS_END(CDMODE) + +!**** *ETRANS_END* - Terminate transform package + +! Purpose. +! -------- +! Terminate transform package. Release all allocated arrays. + +!** Interface. +! ---------- +! CALL ETRANS_END + +! Explicit arguments : None +! -------------------- + +! Method. +! ------- + +! Externals. None +! ---------- + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-03-03 +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! A.Nmiri 15-Nov-2007 Phasing with TFL 32R3 +! A.Bogatchev 16-Sep-2010 Phasing cy37 after G.Radnoti + +! ------------------------------------------------------------------ + +IMPLICIT NONE + +CHARACTER*5, OPTIONAL, INTENT(IN) :: CDMODE + +END SUBROUTINE ETRANS_END +END INTERFACE diff --git a/src/etrans/etrans/include/etrans_inq.h b/src/etrans/etrans/include/etrans_inq.h new file mode 100644 index 000000000..04f2e56e7 --- /dev/null +++ b/src/etrans/etrans/include/etrans_inq.h @@ -0,0 +1,172 @@ +INTERFACE +SUBROUTINE ETRANS_INQ(KRESOL,KSPEC,KSPEC2,KSPEC2G,KSPEC2MX,KNUMP,& + & KGPTOT,KGPTOTG,KGPTOTMX,KGPTOTL,& + & KMYMS,KESM0,KUMPP,KPOSSP,KPTRMS,KALLMS,KDIM0G,& + & KFRSTLAT,KLSTLAT,KFRSTLOFF,KPTRLAT,& + & KPTRFRSTLAT,KPTRLSTLAT,KPTRFLOFF,KSTA,KONL,& + & KULTPP,KPTRLS,& + & KPRTRW,KMYSETW,KMYSETV,KMY_REGION_NS,KMY_REGION_EW,& + & LDSPLITLAT,LDLINEAR_GRID,& + & KSMAX,KMSMAX,KNVALUE,KMVALUE,PLEPINM,KDEF_RESOL,LDLAM,& + & PMU,PGW,PRPNM,KLEI3,KSPOLEGL,KPMS,KCPL2M,KCPL4M,KPROCM) + +!**** *ETRANS_INQ* - Extract information from the transform package + +! Purpose. +! -------- +! Interface routine for extracting information from the T.P. + +!** Interface. +! ---------- +! CALL ETRANS_INQ(...) +! Explicit arguments : All arguments are optional. +! -------------------- +! KRESOL - resolution tag for which info is required ,default is the +! first defined resulution (input) + +! MULTI-TRANSFORMS MANAGEMENT +! KDEF_RESOL - number or resolutions defined +! LDLAM - .T. if the corresponding resolution is LAM, .F. if it is global + +! SPECTRAL SPACE +! KSPEC - number of complex spectral coefficients on this PE +! KSPEC2 - 2*KSPEC +! KSPEC2G - global KSPEC2 +! KSPEC2MX - maximun KSPEC2 among all PEs +! KNUMP - Number of spectral waves handled by this PE +! KGPTOT - Total number of grid columns on this PE +! KGPTOTG - Total number of grid columns on the Globe +! KGPTOTMX - Maximum number of grid columns on any of the PEs +! KGPTOTL - Number of grid columns one each PE (dimension N_REGIONS_NS:N_REGIONS_EW) +! KMYMS - This PEs spectral zonal wavenumbers +! KESM0 - Address in a spectral array of (m, n=m) +! KUMPP - No. of wave numbers each wave set is responsible for +! KPOSSP - Defines partitioning of global spectral fields among PEs +! KPTRMS - Pointer to the first wave number of a given a-set +! KALLMS - Wave numbers for all wave-set concatenated together +! to give all wave numbers in wave-set order +! KDIM0G - Defines partitioning of global spectral fields among PEs +! KSMAX - spectral truncation - n direction +! KMSMAX - spectral truncation - m direction +! KNVALUE - n value for each KSPEC2 spectral coeffient +! KMVALUE - m value for each KSPEC2 spectral coeffient +! LDLINEAR_GRID : .TRUE. if the grid is linear + +! GRIDPOINT SPACE +! KFRSTLAT - First latitude of each a-set in grid-point space +! KLSTTLAT - Last latitude of each a-set in grid-point space +! KFRSTLOFF - Offset for first lat of own a-set in grid-point space +! KPTRLAT - Pointer to the start of each latitude +! KPTRFRSTLAT - Pointer to the first latitude of each a-set in +! NSTA and NONL arrays +! KPTRLSTLAT - Pointer to the last latitude of each a-set in +! NSTA and NONL arrays +! KPTRFLOFF - Offset for pointer to the first latitude of own a-set +! NSTA and NONL arrays, i.e. nptrfrstlat(myseta)-1 +! KSTA - Position of first grid column for the latitudes on a +! processor. The information is available for all processors. +! The b-sets are distinguished by the last dimension of +! nsta().The latitude band for each a-set is addressed by +! nptrfrstlat(jaset),nptrlstlat(jaset), and +! nptrfloff=nptrfrstlat(myseta) on this processors a-set. +! Each split latitude has two entries in nsta(,:) which +! necessitates the rather complex addressing of nsta(,:) +! and the overdimensioning of nsta by N_REGIONS_NS. +! KONL - Number of grid columns for the latitudes on a processor. +! Similar to nsta() in data structure. +! LDSPLITLAT - TRUE if latitude is split in grid point space over +! two a-sets + +! FOURIER SPACE +! KULTPP - number of latitudes for which each a-set is calculating +! the FFT's. +! KPTRLS - pointer to first global latitude of each a-set for which +! it performs the Fourier calculations + +! LEGENDRE +! PMU - sin(Gaussian latitudes) +! PGW - Gaussian weights +! PRPNM - Legendre polynomials +! KLEI3 - First dimension of Legendre polynomials +! KSPOLEGL - Second dimension of Legendre polynomials +! KPMS - Adress for legendre polynomial for given M (NSMAX) +! PLEPINM - Eigen-values of the inverse Laplace operator + +! Method. +! ------- + +! Externals. ESET_RESOL - set resolution +! ---------- + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-03-03 +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! A.Nmiri 15-Nov-2007 Phasing with TFL 32R3 +! A.Bogatchev 16-Sep-2010 Phasing with TFL 36R4 +! R. El Khatib 08-Aug-2012 KSMAX,KMSMAX,KNVALUE,KMVALUE,PLEPINM,LDLAM,KDEF_RESOL,LDLINEAR_GRID + +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB + +IMPLICIT NONE + +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KRESOL +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KSPEC +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KSPEC2 +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KSPEC2G +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KSPEC2MX +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KNUMP +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KGPTOT +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KGPTOTG +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KGPTOTMX +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KGPTOTL(:,:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KMYMS(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KESM0(0:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KUMPP(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KPOSSP(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KPTRMS(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KALLMS(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KDIM0G(0:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KFRSTLAT(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KLSTLAT(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KFRSTLOFF +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KPTRLAT(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KPTRFRSTLAT(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KPTRLSTLAT(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KPTRFLOFF +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KSTA(:,:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KONL(:,:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KULTPP(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KPTRLS(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPRTRW +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KMYSETW +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KMYSETV +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KMY_REGION_NS +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KMY_REGION_EW +LOGICAL ,OPTIONAL,INTENT(INOUT) :: LDSPLITLAT(:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(INOUT) :: PMU(:) +REAL(KIND=JPRB) ,OPTIONAL :: PGW(:) ! Argument NOT used +REAL(KIND=JPRB) ,OPTIONAL,INTENT(INOUT) :: PRPNM(:,:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KLEI3 +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KSPOLEGL +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KPMS(0:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KCPL2M(0:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KCPL4M(0:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(INOUT) :: KPROCM(0:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KSMAX +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KMSMAX +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KNVALUE(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KMVALUE(:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PLEPINM(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KDEF_RESOL +LOGICAL ,OPTIONAL,INTENT(OUT) :: LDLAM +LOGICAL ,OPTIONAL,INTENT(OUT) :: LDLINEAR_GRID + +END SUBROUTINE ETRANS_INQ +END INTERFACE diff --git a/src/etrans/etrans/include/etrans_release.h b/src/etrans/etrans/include/etrans_release.h new file mode 100644 index 000000000..846424c87 --- /dev/null +++ b/src/etrans/etrans/include/etrans_release.h @@ -0,0 +1,6 @@ +INTERFACE +SUBROUTINE ETRANS_RELEASE(KRESOL) +USE PARKIND1 ,ONLY : JPIM +INTEGER(KIND=JPIM),INTENT(IN) :: KRESOL +END SUBROUTINE ETRANS_RELEASE +END INTERFACE diff --git a/src/etrans/etrans/internal/cpl_int_mod.F90 b/src/etrans/etrans/internal/cpl_int_mod.F90 new file mode 100644 index 000000000..2b55a5b22 --- /dev/null +++ b/src/etrans/etrans/internal/cpl_int_mod.F90 @@ -0,0 +1,33 @@ +MODULE CPL_INT_MOD +CONTAINS +SUBROUTINE CPL_INT(PGTF,KENDROWL,KFIELDS,KFFIELDS,KLEN,KSTA,CPL_PROC,KPTRGP) + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +IMPLICIT NONE +INTEGER(KIND=JPIM), INTENT(IN) :: KENDROWL +INTEGER(KIND=JPIM), INTENT(IN) :: KFIELDS +INTEGER(KIND=JPIM), INTENT(IN) :: KFFIELDS +INTEGER(KIND=JPIM), INTENT(IN) :: KLEN +INTEGER(KIND=JPIM), INTENT(IN) :: KSTA(KENDROWL) +INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: KPTRGP(:) +REAL(KIND=JPRB), INTENT(INOUT) :: PGTF(KFIELDS,KLEN) +EXTERNAL CPL_PROC + +INTEGER(KIND=JPIM) :: IPTRGP(KFIELDS) +INTEGER(KIND=JPIM) :: J +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE +!-------------------------------------------------------------- +IF (LHOOK) CALL DR_HOOK('CPL_INT_MOD:CPL_INT',0,ZHOOK_HANDLE) +IF(PRESENT(KPTRGP)) THEN + IPTRGP(:)=KPTRGP(1:KFIELDS) +ELSE + DO J=1,KFIELDS + IPTRGP(J)=J + ENDDO +ENDIF +CALL CPL_PROC(PGTF,KENDROWL,KFIELDS,KFFIELDS,KLEN,KSTA,IPTRGP) +IF (LHOOK) CALL DR_HOOK('CPL_INT_MOD:CPL_INT',1,ZHOOK_HANDLE) +END SUBROUTINE CPL_INT +END MODULE CPL_INT_MOD diff --git a/src/etrans/etrans/internal/easre1ad_mod.F90 b/src/etrans/etrans/internal/easre1ad_mod.F90 new file mode 100644 index 000000000..b382d7836 --- /dev/null +++ b/src/etrans/etrans/internal/easre1ad_mod.F90 @@ -0,0 +1,80 @@ +MODULE EASRE1AD_MOD +CONTAINS +SUBROUTINE EASRE1AD(KM,KMLOC,KF_OUT_LT,PIA) + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +!USE TPM_TRANS +USE EASRE1BAD_MOD ,ONLY : EASRE1BAD + +!**** *EASRE1AD* - Recombine antisymmetric and symmetric parts - adjoint + +! Purpose. +! -------- +! To recombine the antisymmetric and symmetric parts of the +! Fourier arrays and update the correct parts of the state +! variables. + +!** Interface. +! ---------- +! *CALL* *EASRE1AD(...) + +! Explicit arguments : +! -------------------- +! KM - zonal wavenumber +! KMLOC - local zonal wavenumber +! PAOA1 - antisymmetric part of Fourier +! fields for zonal wavenumber KM (basic +! variables and N-S derivatives) +! PSOA1 - symmetric part of Fourier +! fields for zonal wavenumber KM (basic +! variables and N-S derivatives) + +! Implicit arguments : None +! -------------------- + +! Method. +! ------- + +! Externals. EASRE1BAD - basic recombination routine +! ---------- + +! Reference. +! ---------- +! ECMWF Research Department documentation of the IFS + +! Author. +! ------- +! Mats Hamrud and Philippe Courtier *ECMWF* + +! Modifications. +! -------------- +! Original : 00-02-01 From ASRE1AD in IFS CY22R1 +! M.Hamrud 01-Oct-2003 CY28 Cleaning + +! ------------------------------------------------------------------ + +IMPLICIT NONE + +INTEGER(KIND=JPIM) , INTENT(IN) :: KM +INTEGER(KIND=JPIM) , INTENT(IN) :: KMLOC +INTEGER(KIND=JPIM) , INTENT(IN) :: KF_OUT_LT + +REAL(KIND=JPRB) , INTENT(OUT) :: PIA(:,:) + +INTEGER(KIND=JPIM) :: IFLDS +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +IF (LHOOK) CALL DR_HOOK('EASRE1AD_MOD:EASRE1AD',0,ZHOOK_HANDLE) +IFLDS = KF_OUT_LT + +CALL EASRE1BAD(IFLDS,KM,KMLOC,PIA) +IF (LHOOK) CALL DR_HOOK('EASRE1AD_MOD:EASRE1AD',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE EASRE1AD +END MODULE EASRE1AD_MOD diff --git a/src/etrans/etrans/internal/easre1b_mod.F90 b/src/etrans/etrans/internal/easre1b_mod.F90 new file mode 100644 index 000000000..cae14b396 --- /dev/null +++ b/src/etrans/etrans/internal/easre1b_mod.F90 @@ -0,0 +1,93 @@ +MODULE EASRE1B_MOD +CONTAINS +SUBROUTINE EASRE1B(KFC,KM,KMLOC,PIA) + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_DIM ,ONLY : R +USE TPMALD_DIM ,ONLY : RALD +USE TPM_TRANS ,ONLY : FOUBUF_IN +USE TPM_DISTR ,ONLY : D + +!**** *ASRE1B* - Recombine antisymmetric and symmetric parts + +! Purpose. +! -------- +! To recombine the antisymmetric and symmetric parts of the +! Fourier arrays and update the correct parts of the state +! variables. + +!** Interface. +! ---------- +! *CALL* *ASRE1B(..) + +! Explicit arguments : +! ------------------- KFC - number of fields (input-c) +! KM - zonal wavenumber(input-c) +! KMLOC - local version of KM (input-c) +! PAOA - antisymmetric part of Fourier +! fields for zonal wavenumber KM (input) +! PSOA - symmetric part of Fourier +! fields for zonal wavenumber KM (input) + +! Implicit arguments : FOUBUF_IN - output buffer (output) +! -------------------- + +! Method. +! ------- + +! Externals. None. +! ---------- + +! Reference. +! ---------- +! ECMWF Research Department documentation of the IFS + +! Author. +! ------- +! Mats Hamrud and Philippe Courtier *ECMWF* + +! Modifications. +! -------------- +! Original : 00-02-01 From ASRE1B in IFS CY22R1 +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! R. El Khatib 26-Aug-2021 Optimizations +! ------------------------------------------------------------------ + +IMPLICIT NONE + +INTEGER(KIND=JPIM), INTENT(IN) :: KFC +INTEGER(KIND=JPIM), INTENT(IN) :: KM +INTEGER(KIND=JPIM), INTENT(IN) :: KMLOC +REAL(KIND=JPRB), INTENT(IN) :: PIA(RALD%NDGLSUR+R%NNOEXTZG,KFC) + +INTEGER(KIND=JPIM) :: JFLD, JGL ,IPROC +INTEGER(KIND=JPIM) :: IISTAN +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE +! ------------------------------------------------------------------ + +!* 1. RECOMBINATION OF SYMMETRIC AND ANTSYMMETRIC PARTS. +! --------------------------------------------------- +IF (LHOOK) CALL DR_HOOK('EASRE1B_MOD:EASRE1B',0,ZHOOK_HANDLE) +#ifdef __INTEL_COMPILER +!$OMP SIMD PRIVATE(JGL) +DO JFLD=1,KFC + DO JGL=1,R%NDGL + FOUBUF_IN((D%NSTAGT0B(D%NPROCL(JGL))+D%NPNTGTB1(KMLOC,JGL))*KFC+JFLD)=PIA(JGL,JFLD) + ENDDO +ENDDO +#else +DO JGL=1,R%NDGL + IPROC=D%NPROCL(JGL) + IISTAN=(D%NSTAGT0B(IPROC) + D%NPNTGTB1(KMLOC,JGL))*KFC + DO JFLD =1,KFC + FOUBUF_IN(IISTAN+JFLD)=PIA(JGL,JFLD) + ENDDO +ENDDO +#endif +IF (LHOOK) CALL DR_HOOK('EASRE1B_MOD:EASRE1B',1,ZHOOK_HANDLE) +! ------------------------------------------------------------------ + +END SUBROUTINE EASRE1B +END MODULE EASRE1B_MOD diff --git a/src/etrans/etrans/internal/easre1bad_mod.F90 b/src/etrans/etrans/internal/easre1bad_mod.F90 new file mode 100644 index 000000000..0aa6f3435 --- /dev/null +++ b/src/etrans/etrans/internal/easre1bad_mod.F90 @@ -0,0 +1,97 @@ +MODULE EASRE1BAD_MOD +CONTAINS +SUBROUTINE EASRE1BAD(KFC,KM,KMLOC,PIA) + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_DIM ,ONLY : R +USE TPMALD_DIM ,ONLY : RALD +USE TPM_TRANS ,ONLY : FOUBUF_IN +USE TPM_DISTR ,ONLY : D + +!**** *EASRE1BAD* - Recombine antisymmetric and symmetric parts - adjoint + +! Purpose. +! -------- +! To recombine the antisymmetric and symmetric parts of the +! Fourier arrays and update the correct parts of the state +! variables. + +!** Interface. +! ---------- +! *CALL* *EASRE1BAD(..) + +! Explicit arguments : +! ------------------- KFC - number of fields (input-c) +! KM - zonal wavenumber(input-c) +! KMLOC - local version of KM (input-c) +! PAOA - antisymmetric part of Fourier +! fields for zonal wavenumber KM (input) +! PSOA - symmetric part of Fourier +! fields for zonal wavenumber KM (input) + +! Implicit arguments : FOUBUF_IN - output buffer (output) +! -------------------- + +! Method. +! ------- + +! Externals. None. +! ---------- + +! Reference. +! ---------- +! ECMWF Research Department documentation of the IFS + +! Author. +! ------- +! Mats Hamrud and Philippe Courtier *ECMWF* + +! Modifications. +! -------------- +! Original : 00-02-01 From ASRE1BAD in IFS CY22R1 +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! R. El Khatib 26-Aug-2021 Optimizations +! ------------------------------------------------------------------ + +IMPLICIT NONE + +INTEGER(KIND=JPIM), INTENT(IN) :: KFC +INTEGER(KIND=JPIM), INTENT(IN) :: KM +INTEGER(KIND=JPIM), INTENT(IN) :: KMLOC + +REAL(KIND=JPRB), INTENT(OUT) :: PIA(RALD%NDGLSUR+R%NNOEXTZG,KFC) + +INTEGER(KIND=JPIM) :: JFLD, JGL ,IPROC +INTEGER(KIND=JPIM) :: IISTAN +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +!* 1. RECOMBINATION OF SYMMETRIC AND ANTSYMMETRIC PARTS. +! --------------------------------------------------- + +IF (LHOOK) CALL DR_HOOK('EASRE1BAD_MOD:EASRE1BAD',0,ZHOOK_HANDLE) +#ifdef __INTEL_COMPILER +!$OMP SIMD PRIVATE(JGL) +DO JFLD =1,KFC + DO JGL=1,R%NDGL + PIA(JGL,JFLD)=FOUBUF_IN((D%NSTAGT0B(D%NPROCL(JGL))+D%NPNTGTB1(KMLOC,JGL))*KFC+JFLD) + ENDDO +ENDDO +#else +DO JGL=1,R%NDGL + IPROC=D%NPROCL(JGL) + DO JFLD =1,KFC + IISTAN=(D%NSTAGT0B(IPROC) + D%NPNTGTB1(KMLOC,JGL))*KFC + PIA(JGL,JFLD)=FOUBUF_IN(IISTAN+JFLD) + ENDDO +ENDDO +#endif +IF (LHOOK) CALL DR_HOOK('EASRE1BAD_MOD:EASRE1BAD',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE EASRE1BAD +END MODULE EASRE1BAD_MOD diff --git a/src/etrans/etrans/internal/edealloc_resol_mod.F90 b/src/etrans/etrans/internal/edealloc_resol_mod.F90 new file mode 100644 index 000000000..5d341b92f --- /dev/null +++ b/src/etrans/etrans/internal/edealloc_resol_mod.F90 @@ -0,0 +1,102 @@ +MODULE EDEALLOC_RESOL_MOD +CONTAINS +SUBROUTINE EDEALLOC_RESOL(KRESOL) + +!**** *EDEALLOC_RESOL_MOD* - Deallocations of a resolution + +! Purpose. +! -------- +! Release allocated arrays for a given resolution + +!** Interface. +! ---------- +! CALL EDEALLOC_RESOL_MOD + +! Explicit arguments : KRESOL : resolution tag +! -------------------- + +! Method. +! ------- + +! Externals. None +! ---------- + +! Author. +! ------- +! R. El Khatib *METEO-FRANCE* + +! Modifications. +! -------------- +! Original : 09-Jul-2013 from etrans_end +! B. Bochenek (Apr 2015): Phasing: update +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB + +USE TPM_GEN ,ONLY : LENABLED, NOUT +USE TPM_DISTR ,ONLY : D +USE TPM_GEOMETRY ,ONLY : G +USE TPM_FIELDS ,ONLY : F +USE TPM_FFT ,ONLY : T +#ifdef WITH_FFTW +USE TPM_FFTW ,ONLY : TW,DESTROY_PLANS_FFTW +#endif +USE TPM_FLT ,ONLY : S + +USE ESET_RESOL_MOD ,ONLY : ESET_RESOL + +IMPLICIT NONE + +INTEGER(KIND=JPIM), INTENT(IN) :: KRESOL + +! ------------------------------------------------------------------ + +IF (.NOT.LENABLED(KRESOL)) THEN + + WRITE(UNIT=NOUT,FMT='('' EDEALLOC_RESOL WARNING: KRESOL = '',I3,'' ALREADY DISABLED '')') KRESOL + +ELSE + + CALL ESET_RESOL(KRESOL) + + !TPM_DISTR + DEALLOCATE(D%NFRSTLAT,D%NLSTLAT,D%NPTRLAT,D%NPTRFRSTLAT,D%NPTRLSTLAT) + DEALLOCATE(D%LSPLITLAT,D%NSTA,D%NONL,D%NGPTOTL,D%NPROCA_GP) + + IF(D%LWEIGHTED_DISTR) THEN + DEALLOCATE(D%RWEIGHT) + ENDIF + + IF(.NOT.D%LGRIDONLY) THEN + + DEALLOCATE(D%MYMS,D%NUMPP,D%NPOSSP,D%NPROCM,D%NDIM0G,D%NASM0,D%NATM0) + DEALLOCATE(D%NLATLS,D%NLATLE,D%NPMT,D%NPMS,D%NPMG,D%NULTPP,D%NPROCL) + DEALLOCATE(D%NPTRLS,D%NALLMS,D%NPTRMS,D%NSTAGT0B,D%NSTAGT1B,D%NPNTGTB0) + DEALLOCATE(D%NPNTGTB1,D%NLTSFTB,D%NLTSGTB,D%MSTABF) + DEALLOCATE(D%NSTAGTF) + + !TPM_FFT + DEALLOCATE(T%TRIGS,T%NFAX) +#ifdef WITH_FFTW + !TPM_FFTW + IF( TW%LFFTW )THEN + CALL DESTROY_PLANS_FFTW + ENDIF +#endif + !TPM_GEOMETRY + DEALLOCATE(G%NMEN,G%NDGLU) + + ELSE + + DEALLOCATE(G%NLOEN) + + ENDIF + + LENABLED(KRESOL)=.FALSE. + +ENDIF + +! ------------------------------------------------------------------ + +END SUBROUTINE EDEALLOC_RESOL +END MODULE EDEALLOC_RESOL_MOD diff --git a/src/etrans/etrans/internal/edir_trans_ctl_mod.F90 b/src/etrans/etrans/internal/edir_trans_ctl_mod.F90 new file mode 100644 index 000000000..34c6db0c5 --- /dev/null +++ b/src/etrans/etrans/internal/edir_trans_ctl_mod.F90 @@ -0,0 +1,202 @@ +MODULE EDIR_TRANS_CTL_MOD +CONTAINS +SUBROUTINE EDIR_TRANS_CTL(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS,KF_UV,KF_SCALARS,& + & PSPVOR,PSPDIV,PSPSCALAR,KVSETUV,KVSETSC,PGP,& + & PSPSC3A,PSPSC3B,PSPSC2,KVSETSC3A,KVSETSC3B,KVSETSC2,PGPUV,PGP3A,PGP3B,PGP2,& + & PMEANU,PMEANV,AUX_PROC) + +!**** *EDIR_TRANS_CTL* - Control routine for direct spectral transform. + +! Purpose. +! -------- +! Control routine for the direct spectral transform + +!** Interface. +! ---------- +! CALL EDIR_TRANS_CTL(...) + +! Explicit arguments : +! -------------------- +! KF_UV_G - global number of spectral u-v fields +! KF_SCALARS_G - global number of scalar spectral fields +! KF_GP - total number of output gridpoint fields +! KF_FS - total number of fields in fourier space +! KF_UV - local number of spectral u-v fields +! KF_SCALARS - local number of scalar spectral fields +! PSPVOR(:,:) - spectral vorticity +! PSPDIV(:,:) - spectral divergence +! PSPSCALAR(:,:) - spectral scalarvalued fields +! KVSETUV(:) - indicating which 'b-set' in spectral space owns a +! vor/div field. Equivalant to NBSETLEV in the IFS. +! The length of KVSETUV should be the GLOBAL number +! of u/v fields which is the dimension of u and v releated +! fields in grid-point space. +! KVESETSC(:) - indicating which 'b-set' in spectral space owns a +! scalar field. As for KVSETUV this argument is required +! if the total number of processors is greater than +! the number of processors used for distribution in +! spectral wave space. +! PMEANU,PMEANV - mean winds +! AUX_PROC - optional external procedure for biperiodization of +! aux.fields +! PGP(:,:,:) - gridpoint fields + +! The ordering of the output fields is as follows (all +! parts are optional depending on the input switches): + +! u : KF_UV_G fields +! v : KF_UV_G fields +! scalar fields : KF_SCALARS_G fields + +! Method. +! ------- + +! Externals. SHUFFLE - reshuffle fields for load balancing +! ---------- FIELD_SPLIT - split fields in NPROMATR packets +! LTDIR_CTL - control of Legendre transform +! FTDIR_CTL - control of Fourier transform + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 01-01-03 +! G. Radnoti 01-03-13 adaptation to aladin +! 01-08-28 : G. Radnoti & R. El Khatib Fix for NPROMATR /= 0 +! 02-09-30 : P. Smolikova AUX_PROC for d4 in NH +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_GEN ,ONLY : NPROMATR +!USE TPM_TRANS +!USE TPM_DISTR + +USE SHUFFLE_MOD ,ONLY : SHUFFLE +USE FIELD_SPLIT_MOD ,ONLY : FIELD_SPLIT +USE ELTDIR_CTL_MOD ,ONLY : ELTDIR_CTL +USE EFTDIR_CTL_MOD ,ONLY : EFTDIR_CTL + +IMPLICIT NONE + +! Declaration of arguments + +INTEGER(KIND=JPIM), INTENT(IN) :: KF_UV_G +INTEGER(KIND=JPIM), INTENT(IN) :: KF_SCALARS_G +INTEGER(KIND=JPIM), INTENT(IN) :: KF_GP +INTEGER(KIND=JPIM), INTENT(IN) :: KF_FS +INTEGER(KIND=JPIM), INTENT(IN) :: KF_UV +INTEGER(KIND=JPIM), INTENT(IN) :: KF_SCALARS +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPVOR(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPDIV(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPSCALAR(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPSC3A(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPSC3B(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPSC2(:,:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETUV(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC3A(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC3B(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC2(:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PGP(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PGPUV(:,:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PGP3A(:,:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PGP3B(:,:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PGP2(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PMEANU(:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PMEANV(:) +EXTERNAL AUX_PROC +OPTIONAL AUX_PROC + +! Local variables + +INTEGER(KIND=JPIM) :: IPTRGP(KF_GP),IPTRSPUV(NPROMATR),IPTRSPSC(NPROMATR) +INTEGER(KIND=JPIM) :: ISHFUV_G(KF_GP),ISHFSC_G(KF_GP) +INTEGER(KIND=JPIM) :: IVSETUV(KF_GP),IVSETSC(KF_GP) +INTEGER(KIND=JPIM) :: IBLKS,JBLK,ISTUV_G,IENUV_G +INTEGER(KIND=JPIM) :: IF_UV_G,IF_UV,ISTUV,IF_SCALARS,IF_SCALARS_G,IF_FS,IF_GP +INTEGER(KIND=JPIM) :: JFLD,ISTSC_G,IENSC_G,ISTSC,IENSC,IENUV,IF_GPB +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +! Perform transform + +IF (LHOOK) CALL DR_HOOK('EDIR_TRANS_CTL_MOD:EDIR_TRANS_CTL',0,ZHOOK_HANDLE) +IF_GPB = 2*KF_UV_G+KF_SCALARS_G +IF(NPROMATR > 0 .AND. IF_GPB > NPROMATR) THEN + + ! Fields to be split into packets + + CALL SHUFFLE(KF_UV_G,KF_SCALARS_G,ISHFUV_G,IVSETUV,ISHFSC_G,IVSETSC, & + & KVSETUV,KVSETSC) + + IBLKS=(IF_GPB-1)/NPROMATR+1 + + DO JBLK=1,IBLKS + + CALL FIELD_SPLIT(JBLK,KF_GP,KF_UV_G,IVSETUV,IVSETSC,& + & ISTUV_G,IENUV_G,IF_UV_G,ISTSC_G,IENSC_G,IF_SCALARS_G,& + & ISTUV,IENUV,IF_UV,ISTSC,IENSC,IF_SCALARS) + + IF_FS = 2*IF_UV + IF_SCALARS + IF_GP = 2*IF_UV_G+IF_SCALARS_G + DO JFLD=1,IF_UV_G + IPTRGP(JFLD) = ISHFUV_G(ISTUV_G+JFLD-1) + IPTRGP(JFLD+IF_UV_G) = KF_UV_G+ISHFUV_G(ISTUV_G+JFLD-1) + ENDDO + DO JFLD=1,IF_SCALARS_G + IPTRGP(JFLD+2*IF_UV_G) = 2*KF_UV_G+ISHFSC_G(ISTSC_G+JFLD-1) + ENDDO + DO JFLD=1,IF_UV + IPTRSPUV(JFLD) = ISTUV+JFLD-1 + ENDDO + DO JFLD=1,IF_SCALARS + IPTRSPSC(JFLD) = ISTSC+JFLD-1 + ENDDO + + IF(IF_UV_G > 0 .AND. IF_SCALARS_G > 0) THEN + CALL EFTDIR_CTL(IF_UV_G,IF_SCALARS_G,IF_GP,IF_FS,IF_GPB,& + & KVSETUV=IVSETUV(ISTUV_G:IENUV_G),& + & KVSETSC=IVSETSC(ISTSC_G:IENSC_G),KPTRGP=IPTRGP,PGP=PGP) + ELSEIF(IF_UV_G > 0) THEN + CALL EFTDIR_CTL(IF_UV_G,IF_SCALARS_G,IF_GP,IF_FS,IF_GPB,& + & KVSETUV=IVSETUV(ISTUV_G:IENUV_G),& + & KPTRGP=IPTRGP,PGP=PGP) + ELSEIF(IF_SCALARS_G > 0) THEN + CALL EFTDIR_CTL(IF_UV_G,IF_SCALARS_G,IF_GP,IF_FS,IF_GPB,& + & KVSETSC=IVSETSC(ISTSC_G:IENSC_G),KPTRGP=IPTRGP,PGP=PGP,& + & AUX_PROC=AUX_PROC) + ENDIF + CALL ELTDIR_CTL(IF_FS,IF_UV,IF_SCALARS, & + & PSPVOR=PSPVOR,PSPDIV=PSPDIV,PSPSCALAR=PSPSCALAR,& + & KFLDPTRUV=IPTRSPUV,KFLDPTRSC=IPTRSPSC,& + & PSPMEANU=PMEANU,PSPMEANV=PMEANV,AUX_PROC=AUX_PROC) + ENDDO +ELSE + + ! No splitting of fields, transform done in one go + + CALL EFTDIR_CTL(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS,IF_GPB,& + & KVSETUV=KVSETUV,KVSETSC=KVSETSC,& + & KVSETSC3A=KVSETSC3A,KVSETSC3B=KVSETSC3B,KVSETSC2=KVSETSC2,& + & PGP=PGP,PGPUV=PGPUV,PGP3A=PGP3A,PGP3B=PGP3B,PGP2=PGP2,& + & AUX_PROC=AUX_PROC) + + CALL ELTDIR_CTL(KF_FS,KF_UV,KF_SCALARS, & + & PSPVOR=PSPVOR,PSPDIV=PSPDIV,PSPSCALAR=PSPSCALAR,& + & PSPSC3A=PSPSC3A,PSPSC3B=PSPSC3B,PSPSC2=PSPSC2,& + & PSPMEANU=PMEANU,PSPMEANV=PMEANV,& + & AUX_PROC=AUX_PROC) + +ENDIF +IF (LHOOK) CALL DR_HOOK('EDIR_TRANS_CTL_MOD:EDIR_TRANS_CTL',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE EDIR_TRANS_CTL +END MODULE EDIR_TRANS_CTL_MOD diff --git a/src/etrans/etrans/internal/edir_trans_ctlad_mod.F90 b/src/etrans/etrans/internal/edir_trans_ctlad_mod.F90 new file mode 100644 index 000000000..34de8eed4 --- /dev/null +++ b/src/etrans/etrans/internal/edir_trans_ctlad_mod.F90 @@ -0,0 +1,194 @@ +MODULE EDIR_TRANS_CTLAD_MOD +CONTAINS +SUBROUTINE EDIR_TRANS_CTLAD(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS,KF_UV,KF_SCALARS,& + & PSPVOR,PSPDIV,PSPSCALAR,KVSETUV,KVSETSC,PGP,& + & PSPSC3A,PSPSC3B,PSPSC2,KVSETSC3A,KVSETSC3B,KVSETSC2,PGPUV,PGP3A,PGP3B,PGP2,& + & PMEANU,PMEANV) + +!**** *EDIR_TRANS_CTLAD* - Control routine for direct spectral transform-adj. + +! Purpose. +! -------- +! Control routine for the direct spectral transform + +!** Interface. +! ---------- +! CALL EDIR_TRANS_CTLAD(...) + +! Explicit arguments : +! -------------------- +! KF_UV_G - global number of spectral u-v fields +! KF_SCALARS_G - global number of scalar spectral fields +! KF_GP - total number of output gridpoint fields +! KF_FS - total number of fields in fourier space +! KF_UV - local number of spectral u-v fields +! KF_SCALARS - local number of scalar spectral fields +! PSPVOR(:,:) - spectral vorticity +! PSPDIV(:,:) - spectral divergence +! PSPSCALAR(:,:) - spectral scalarvalued fields +! KVSETUV(:) - indicating which 'b-set' in spectral space owns a +! vor/div field. Equivalant to NBSETLEV in the IFS. +! The length of KVSETUV should be the GLOBAL number +! of u/v fields which is the dimension of u and v releated +! fields in grid-point space. +! KVESETSC(:) - indicating which 'b-set' in spectral space owns a +! scalar field. As for KVSETUV this argument is required +! if the total number of processors is greater than +! the number of processors used for distribution in +! spectral wave space. +! PGP(:,:,:) - gridpoint fields + +! The ordering of the output fields is as follows (all +! parts are optional depending on the input switches): + +! u : KF_UV_G fields +! v : KF_UV_G fields +! scalar fields : KF_SCALARS_G fields + +! Method. +! ------- + +! Externals. SHUFFLE - reshuffle fields for load balancing +! ---------- FIELD_SPLIT - split fields in NPROMATR packets +! ELTDIR_CTLAD - control of Legendre transform +! EFTDIR_CTLAD - control of Fourier transform + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 01-01-03 +! 01-08-28 : G. Radnoti & R. El Khatib Fix for NPROMATR /= 0 +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_GEN ,ONLY : NPROMATR +!USE TPM_TRANS +!USE TPM_DISTR + +USE SHUFFLE_MOD ,ONLY : SHUFFLE +USE FIELD_SPLIT_MOD ,ONLY : FIELD_SPLIT +USE ELTDIR_CTLAD_MOD ,ONLY : ELTDIR_CTLAD +USE EFTDIR_CTLAD_MOD ,ONLY : EFTDIR_CTLAD + +IMPLICIT NONE + +! Declaration of arguments + +INTEGER(KIND=JPIM), INTENT(IN) :: KF_UV_G +INTEGER(KIND=JPIM), INTENT(IN) :: KF_SCALARS_G +INTEGER(KIND=JPIM), INTENT(IN) :: KF_GP +INTEGER(KIND=JPIM), INTENT(IN) :: KF_FS +INTEGER(KIND=JPIM), INTENT(IN) :: KF_UV +INTEGER(KIND=JPIM), INTENT(IN) :: KF_SCALARS +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPVOR(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPDIV(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPSCALAR(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPSC3A(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPSC3B(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPSC2(:,:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETUV(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC3A(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC3B(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC2(:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PGP(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PGPUV(:,:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PGP3A(:,:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PGP3B(:,:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PGP2(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(INOUT) :: PMEANU(:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(INOUT) :: PMEANV(:) + +! Local variables + +INTEGER(KIND=JPIM) :: IPTRGP(KF_GP),IPTRSPUV(NPROMATR),IPTRSPSC(NPROMATR) +INTEGER(KIND=JPIM) :: ISHFUV_G(KF_GP),ISHFSC_G(KF_GP) +INTEGER(KIND=JPIM) :: IVSETUV(KF_GP),IVSETSC(KF_GP) +INTEGER(KIND=JPIM) :: IBLKS,JBLK,ISTUV_G,IENUV_G +INTEGER(KIND=JPIM) :: IF_UV_G,IF_UV,ISTUV,IF_SCALARS,IF_SCALARS_G,IF_FS,IF_GP +INTEGER(KIND=JPIM) :: JFLD,ISTSC_G,IENSC_G,ISTSC,IENSC,IENUV,IF_GPB +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +! Perform transform + +IF (LHOOK) CALL DR_HOOK('EDIR_TRANS_CTLAD_MOD:EDIR_TRANS_CTLAD',0,ZHOOK_HANDLE) +IF_GPB = 2*KF_UV_G+KF_SCALARS_G +IF(NPROMATR > 0 .AND. IF_GPB > NPROMATR) THEN + + ! Fields to be split into packets + + CALL SHUFFLE(KF_UV_G,KF_SCALARS_G,ISHFUV_G,IVSETUV,ISHFSC_G,IVSETSC, & + & KVSETUV,KVSETSC) + + IBLKS=(IF_GPB-1)/NPROMATR+1 + + DO JBLK=1,IBLKS + + CALL FIELD_SPLIT(JBLK,KF_GP,KF_UV_G,IVSETUV,IVSETSC,& + & ISTUV_G,IENUV_G,IF_UV_G,ISTSC_G,IENSC_G,IF_SCALARS_G,& + & ISTUV,IENUV,IF_UV,ISTSC,IENSC,IF_SCALARS) + + IF_FS = 2*IF_UV + IF_SCALARS + IF_GP = 2*IF_UV_G+IF_SCALARS_G + DO JFLD=1,IF_UV_G + IPTRGP(JFLD) = ISHFUV_G(ISTUV_G+JFLD-1) + IPTRGP(JFLD+IF_UV_G) = KF_UV_G+ISHFUV_G(ISTUV_G+JFLD-1) + ENDDO + DO JFLD=1,IF_SCALARS_G + IPTRGP(JFLD+2*IF_UV_G) = 2*KF_UV_G+ISHFSC_G(ISTSC_G+JFLD-1) + ENDDO + DO JFLD=1,IF_UV + IPTRSPUV(JFLD) = ISTUV+JFLD-1 + ENDDO + DO JFLD=1,IF_SCALARS + IPTRSPSC(JFLD) = ISTSC+JFLD-1 + ENDDO + + CALL ELTDIR_CTLAD(IF_FS,IF_UV,IF_SCALARS, & + & PSPVOR=PSPVOR,PSPDIV=PSPDIV,PSPSCALAR=PSPSCALAR,& + & KFLDPTRUV=IPTRSPUV,KFLDPTRSC=IPTRSPSC,& + & PSPMEANU=PMEANU,PSPMEANV=PMEANV) + IF(IF_UV_G > 0 .AND. IF_SCALARS_G > 0) THEN + CALL EFTDIR_CTLAD(IF_UV_G,IF_SCALARS_G,IF_GP,IF_FS,IF_GPB,& + & KVSETUV=IVSETUV(ISTUV_G:IENUV_G),& + & KVSETSC=IVSETSC(ISTSC_G:IENSC_G),KPTRGP=IPTRGP,& + & PGP=PGP) + ELSEIF(IF_UV_G > 0) THEN + CALL EFTDIR_CTLAD(IF_UV_G,IF_SCALARS_G,IF_GP,IF_FS,IF_GPB,& + & KVSETUV=IVSETUV(ISTUV_G:IENUV_G),& + & KPTRGP=IPTRGP,PGP=PGP) + ELSEIF(IF_SCALARS_G > 0) THEN + CALL EFTDIR_CTLAD(IF_UV_G,IF_SCALARS_G,IF_GP,IF_FS,IF_GPB,& + & KVSETSC=IVSETSC(ISTSC_G:IENSC_G),KPTRGP=IPTRGP,& + & PGP=PGP) + ENDIF + ENDDO + +ELSE + + ! No splitting of fields, transform done in one go + + CALL ELTDIR_CTLAD(KF_FS,KF_UV,KF_SCALARS, & + & PSPVOR=PSPVOR,PSPDIV=PSPDIV,PSPSCALAR=PSPSCALAR,& + & PSPSC3A=PSPSC3A,PSPSC3B=PSPSC3B,PSPSC2=PSPSC2,& + & PSPMEANU=PMEANU,PSPMEANV=PMEANV) + + CALL EFTDIR_CTLAD(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS,IF_GPB,& + & KVSETUV=KVSETUV,KVSETSC=KVSETSC,& + & KVSETSC3A=KVSETSC3A,KVSETSC3B=KVSETSC3B,KVSETSC2=KVSETSC2,& + & PGP=PGP,PGPUV=PGPUV,PGP3A=PGP3A,PGP3B=PGP3B,PGP2=PGP2) +ENDIF +IF (LHOOK) CALL DR_HOOK('EDIR_TRANS_CTLAD_MOD:EDIR_TRANS_CTLAD',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE EDIR_TRANS_CTLAD +END MODULE EDIR_TRANS_CTLAD_MOD diff --git a/src/etrans/etrans/internal/edist_spec_control_mod.F90 b/src/etrans/etrans/internal/edist_spec_control_mod.F90 new file mode 100644 index 000000000..ce55ba949 --- /dev/null +++ b/src/etrans/etrans/internal/edist_spec_control_mod.F90 @@ -0,0 +1,3 @@ +MODULE EDIST_SPEC_CONTROL_MOD + ! dead code - merged with DIST_SPEC_CONTROL_MOD +END MODULE EDIST_SPEC_CONTROL_MOD diff --git a/src/etrans/etrans/internal/efsc_mod.F90 b/src/etrans/etrans/internal/efsc_mod.F90 new file mode 100644 index 000000000..77ab4716e --- /dev/null +++ b/src/etrans/etrans/internal/efsc_mod.F90 @@ -0,0 +1,110 @@ +MODULE EFSC_MOD +CONTAINS +SUBROUTINE EFSC(KGL,KF_UV,KF_SCALARS,KF_SCDERS,& + & PUV,PSCALAR,PNSDERS,PEWDERS,PUVDERS) + +!**** *FSC - Division by a*cos(theta), east-west derivatives + +! Purpose. +! -------- +! In Fourier space divide u and v and all north-south +! derivatives by a*cos(theta). Also compute east-west derivatives +! of u,v,thermodynamic, passiv scalar variables and surface +! pressure. + +!** Interface. +! ---------- +! CALL FSC(..) +! Explicit arguments : PUV - u and v +! -------------------- PSCALAR - scalar valued varaibles +! PNSDERS - N-S derivative of S.V.V. +! PEWDERS - E-W derivative of S.V.V. +! PUVDERS - E-W derivative of u and v +! Method. +! ------- + +! Externals. None. +! ---------- + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-03-03 (From SC2FSC) +! M.Hamrud 01-Oct-2003 CY28 Cleaning + +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_TRANS ,ONLY : LUVDER +USE TPM_DISTR ,ONLY : D, MYSETW +!USE TPM_FIELDS +USE TPM_GEOMETRY ,ONLY : G +USE TPMALD_GEO ,ONLY : GALD +! + +IMPLICIT NONE + +INTEGER(KIND=JPIM) , INTENT(IN) :: KGL,KF_UV,KF_SCALARS,KF_SCDERS +REAL(KIND=JPRB) , INTENT(INOUT) :: PUV(:,:) +REAL(KIND=JPRB) , INTENT(IN ) :: PSCALAR(:,:) +REAL(KIND=JPRB) , INTENT(INOUT) :: PNSDERS(:,:) +REAL(KIND=JPRB) , INTENT( OUT) :: PEWDERS(:,:) +REAL(KIND=JPRB) , INTENT( OUT) :: PUVDERS(:,:) + +INTEGER(KIND=JPIM) :: IMEN,ISTAGTF + +INTEGER(KIND=JPIM) :: JF,IGLG,II,IR,JM +REAL(KIND=JPRB) :: ZIM +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE +! ------------------------------------------------------------------ + +IF (LHOOK) CALL DR_HOOK('EFSC_MOD:EFSC',0,ZHOOK_HANDLE) +IGLG = D%NPTRLS(MYSETW)+KGL-1 +IMEN = G%NMEN(IGLG) +ISTAGTF = D%NSTAGTF(KGL) + +! ------------------------------------------------------------------ + +!* EAST-WEST DERIVATIVES +! --------------------- + +!* 2.1 U AND V. + +IF(LUVDER)THEN + DO JM=0,IMEN + ZIM=REAL(JM,JPRB)*GALD%EXWN + IR = ISTAGTF+2*JM+1 + II = IR+1 +! use unroll to provoke vectorization of outer loop +!cdir unroll=4 + DO JF=1,2*KF_UV + PUVDERS(JF,IR) = -PUV(JF,II)*ZIM + PUVDERS(JF,II) = PUV(JF,IR)*ZIM + ENDDO + ENDDO +ENDIF + +!* 2.2 SCALAR VARIABLES + +IF(KF_SCDERS > 0)THEN + DO JM=0,IMEN + ZIM=REAL(JM,JPRB)*GALD%EXWN + IR = ISTAGTF+2*JM+1 + II = IR+1 + DO JF=1,KF_SCALARS + PEWDERS(JF,IR) = -PSCALAR(JF,II)*ZIM + PEWDERS(JF,II) = PSCALAR(JF,IR)*ZIM + ENDDO + ENDDO +ENDIF +IF (LHOOK) CALL DR_HOOK('EFSC_MOD:EFSC',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE EFSC +END MODULE EFSC_MOD diff --git a/src/etrans/etrans/internal/efscad_mod.F90 b/src/etrans/etrans/internal/efscad_mod.F90 new file mode 100644 index 000000000..4b335f4fa --- /dev/null +++ b/src/etrans/etrans/internal/efscad_mod.F90 @@ -0,0 +1,121 @@ +MODULE EFSCAD_MOD +CONTAINS +SUBROUTINE EFSCAD(KGL,KF_UV,KF_SCALARS,KF_SCDERS,& + & PUV,PSCALAR,PNSDERS,PEWDERS,PUVDERS) + +!**** *EFSCAD - Division by a*cos(theta), east-west derivatives - adjoint + +! Purpose. +! -------- +! In Fourier space divide u and v and all north-south +! derivatives by a*cos(theta). Also compute east-west derivatives +! of u,v,thermodynamic, passiv scalar variables and surface +! pressure. + +!** Interface. +! ---------- +! CALL EFSCAD(..) +! Explicit arguments : PUV - u and v +! -------------------- PSCALAR - scalar valued varaibles +! PNSDERS - N-S derivative of S.V.V. +! PEWDERS - E-W derivative of S.V.V. +! PUVDERS - E-W derivative of u and v +! Method. +! ------- + +! Externals. None. +! ---------- + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-03-03 (From SC2FSC) +! M.Hamrud 01-Oct-2003 CY28 Cleaning + +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_TRANS ,ONLY : LUVDER +USE TPM_DISTR ,ONLY : D, MYSETW +!USE TPM_FIELDS +USE TPM_GEOMETRY ,ONLY : G + +USE TPMALD_GEO ,ONLY : GALD + +IMPLICIT NONE + +INTEGER(KIND=JPIM) , INTENT(IN) :: KGL,KF_UV,KF_SCALARS,KF_SCDERS +REAL(KIND=JPRB) , INTENT(INOUT) :: PUV(:,:) +REAL(KIND=JPRB) , INTENT(INOUT) :: PSCALAR(:,:) +REAL(KIND=JPRB) , INTENT(INOUT) :: PNSDERS(:,:) +REAL(KIND=JPRB) , INTENT(INOUT) :: PEWDERS(:,:) +REAL(KIND=JPRB) , INTENT(INOUT) :: PUVDERS(:,:) + +INTEGER(KIND=JPIM) :: IMEN,ISTAGTF + +INTEGER(KIND=JPIM) :: JF,IGLG,II,IR,JM + +REAL(KIND=JPRB) :: ZIM +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +IF (LHOOK) CALL DR_HOOK('EFSCAD_MOD:EFSCAD',0,ZHOOK_HANDLE) +IGLG = D%NPTRLS(MYSETW)+KGL-1 +IMEN = G%NMEN(IGLG) +ISTAGTF = D%NSTAGTF(KGL) + +! ------------------------------------------------------------------ + +!* 2. EAST-WEST DERIVATIVES +! --------------------- + +!* 2.1 U AND V. + +IF(LUVDER)THEN + DO JM=0,IMEN + + ZIM=REAL(JM,JPRB)*GALD%EXWN + + IR = ISTAGTF+2*JM+1 + II = IR+1 + DO JF=1,2*KF_UV + + PUV(JF,II) = PUV(JF,II) - ZIM*PUVDERS(JF,IR) + PUV(JF,IR) = PUV(JF,IR) + ZIM*PUVDERS(JF,II) + + PUVDERS(JF,IR) = 0.0_JPRB + PUVDERS(JF,II) = 0.0_JPRB + ENDDO + ENDDO +ENDIF + +!* 2.2 SCALAR VARIABLES + +IF(KF_SCDERS > 0)THEN + DO JM=0,IMEN + + ZIM=REAL(JM,JPRB)*GALD%EXWN + + IR = ISTAGTF+2*JM+1 + II = IR+1 + DO JF=1,KF_SCALARS + + PSCALAR(JF,II) = PSCALAR(JF,II) - ZIM* PEWDERS(JF,IR) + PSCALAR(JF,IR) = PSCALAR(JF,IR) + ZIM* PEWDERS(JF,II) + + PEWDERS(JF,IR) = 0.0_JPRB + PEWDERS(JF,II) = 0.0_JPRB + ENDDO + ENDDO +ENDIF +IF (LHOOK) CALL DR_HOOK('EFSCAD_MOD:EFSCAD',1,ZHOOK_HANDLE) +! ------------------------------------------------------------------ + +END SUBROUTINE EFSCAD +END MODULE EFSCAD_MOD diff --git a/src/etrans/etrans/internal/eftdir_ctl_mod.F90 b/src/etrans/etrans/internal/eftdir_ctl_mod.F90 new file mode 100644 index 000000000..212bcc956 --- /dev/null +++ b/src/etrans/etrans/internal/eftdir_ctl_mod.F90 @@ -0,0 +1,214 @@ +MODULE EFTDIR_CTL_MOD +CONTAINS +SUBROUTINE EFTDIR_CTL(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS,KF_GPB, & + & KVSETUV,KVSETSC,KPTRGP,& + & KVSETSC3A,KVSETSC3B,KVSETSC2,& + & PGP,PGPUV,PGP3A,PGP3B,PGP2,AUX_PROC) + +!**** *EFTDIR_CTL - Direct Fourier transform control + +! Purpose. Control routine for Grid-point to Fourier transform +! -------- + +!** Interface. +! ---------- +! CALL FTDIR_CTL(..) + +! Explicit arguments : +! -------------------- +! KF_UV_G - global number of spectral u-v fields +! KF_SCALARS_G - global number of scalar spectral fields +! KF_GP - total number of output gridpoint fields +! KF_FS - total number of fields in fourier space +! KF_GPB - total global number of output gridpoint fields +! PGP - gridpoint array +! KVSETUV - "B" set in spectral/fourier space for +! u and v variables +! KVSETSC - "B" set in spectral/fourier space for +! scalar variables +! KPTRGP - pointer array to fields in gridpoint space + +! Method. +! ------- + +! Externals. TRGTOL - transposition routine +! ---------- FOURIER_OUT - copy fourier data to Fourier buffer +! FTDIR - fourier transform + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-03-03 +! G. Radnoti 01-03-13 adaptation to aladin (coupling) +! 01-08-28 : G. Radnoti & R. El Khatib Fix for NPROMATR /= 0 +! 19-11-01 : G. Radnoti bug corection by introducing cpl_int interface +! 02-09-30 : P. Smolikova AUX_PROC for d4 in NH +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! D. Degrauwe (Feb 2012): Alternative extension zone (E') +! R. El Khatib 09-Sep-2020 NSTACK_MEMORY_TR +! R. El Khatib 02-Jun-2022 Optimization/Cleaning +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_GEN ,ONLY : NSTACK_MEMORY_TR +USE TPM_DIM ,ONLY : R +USE TPM_TRANS ,ONLY : FOUBUF_IN +USE TPM_DISTR ,ONLY : D + +USE TRGTOL_MOD ,ONLY : TRGTOL +USE FOURIER_OUT_MOD ,ONLY : FOURIER_OUT +USE FTDIR_MOD ,ONLY : FTDIR +USE EXTPER_MOD ,ONLY : EXTPER +! + +IMPLICIT NONE + +! Dummy arguments + +INTEGER(KIND=JPIM),INTENT(IN) :: KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS,KF_GPB +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETUV(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KPTRGP(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC3A(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC3B(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC2(:) +REAL(KIND=JPRB),OPTIONAL , INTENT(IN) :: PGP(:,:,:) +REAL(KIND=JPRB),OPTIONAL , INTENT(IN) :: PGPUV(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL , INTENT(IN) :: PGP3A(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL , INTENT(IN) :: PGP3B(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL , INTENT(IN) :: PGP2(:,:,:) +EXTERNAL AUX_PROC +OPTIONAL AUX_PROC + +! Local variables +REAL(KIND=JPRB),TARGET :: ZGTF_STACK(KF_FS*MIN(1,MAX(0,NSTACK_MEMORY_TR)),D%NLENGTF) +REAL(KIND=JPRB),TARGET, ALLOCATABLE :: ZGTF_HEAP(:,:) +REAL(KIND=JPRB),POINTER, CONTIGUOUS :: ZGTF(:,:) +REAL(KIND=JPRB) :: ZDUM +INTEGER(KIND=JPIM) :: IST,INUL,JGL,IGL,IBLEN +INTEGER(KIND=JPIM) :: IVSETUV(KF_UV_G) +INTEGER(KIND=JPIM) :: IVSETSC(KF_SCALARS_G) +INTEGER(KIND=JPIM) :: IVSET(KF_GP) +INTEGER(KIND=JPIM) :: IFGP2,IFGP3A,IFGP3B,IOFF,J3 +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +! Field distribution in Spectral/Fourier space + +IF (LHOOK) CALL DR_HOOK('EFTDIR_CTL_MOD:EFTDIR_CTL',0,ZHOOK_HANDLE) + +IF(PRESENT(KVSETUV)) THEN + IVSETUV(:) = KVSETUV(:) +ELSE + IVSETUV(:) = -1 +ENDIF +IVSETSC(:) = -1 +IF(PRESENT(KVSETSC)) THEN + IVSETSC(:) = KVSETSC(:) +ELSE + IOFF=0 + IF(PRESENT(KVSETSC2)) THEN + IFGP2=UBOUND(KVSETSC2,1) + IVSETSC(1:IFGP2)=KVSETSC2(:) + IOFF=IOFF+IFGP2 + ENDIF + IF(PRESENT(KVSETSC3A)) THEN + IFGP3A=UBOUND(KVSETSC3A,1) + DO J3=1,UBOUND(PGP3A,3) + IVSETSC(IOFF+1:IOFF+IFGP3A)=KVSETSC3A(:) + IOFF=IOFF+IFGP3A + ENDDO + ENDIF + IF(PRESENT(KVSETSC3B)) THEN + IFGP3B=UBOUND(KVSETSC3B,1) + DO J3=1,UBOUND(PGP3B,3) + IVSETSC(IOFF+1:IOFF+IFGP3B)=KVSETSC3B(:) + IOFF=IOFF+IFGP3B + ENDDO + ENDIF +ENDIF + +IST = 1 +IF(KF_UV_G > 0) THEN + IVSET(IST:IST+KF_UV_G-1) = IVSETUV(:) + IST = IST+KF_UV_G + IVSET(IST:IST+KF_UV_G-1) = IVSETUV(:) + IST = IST+KF_UV_G +ENDIF +IF(KF_SCALARS_G > 0) THEN + IVSET(IST:IST+KF_SCALARS_G-1) = IVSETSC(:) + IST = IST+KF_SCALARS_G +ENDIF + +IF (NSTACK_MEMORY_TR == 1) THEN + ZGTF => ZGTF_STACK(:,:) +ELSE + ALLOCATE(ZGTF_HEAP(KF_FS,D%NLENGTF)) +! Now, force the OS to allocate this shared array right now, not when it starts +! to be used which is an OPEN-MP loop, that would cause a threads +! synchronization lock : + IF (KF_FS > 0 .AND. D%NLENGTF > 0) THEN + ZGTF_HEAP(1,1)=HUGE(1._JPRB) + ENDIF + ZGTF => ZGTF_HEAP(:,:) +ENDIF + +! Transposition + +CALL GSTATS(158,0) +CALL TRGTOL(ZGTF,KF_FS,KF_GP,KF_SCALARS_G,IVSET,KPTRGP,& + & PGP,PGPUV,PGP3A,PGP3B,PGP2) +CALL GSTATS(158,1) +CALL GSTATS(106,0) + +! Periodization of auxiliary fields in x direction +IF(R%NNOEXTZL>0) THEN + CALL EXTPER(ZGTF,R%NDLON+R%NNOEXTZL,1,R%NDLON,KF_FS,D%NDGL_FS,D%NSTAGTF,0) +ELSE + IF (PRESENT(AUX_PROC)) THEN + CALL AUX_PROC(ZGTF,ZDUM,KF_FS,D%NLENGTF,1,D%NDGL_FS,0,.TRUE.,& + & D%NSTAGTF,INUL,INUL,INUL) + ENDIF +ENDIF + +! Fourier transform + +IBLEN=D%NLENGT0B*2*KF_FS +IF (ALLOCATED(FOUBUF_IN)) THEN + IF (MAX(1,IBLEN) > SIZE(FOUBUF_IN)) THEN + DEALLOCATE(FOUBUF_IN) + ALLOCATE(FOUBUF_IN(MAX(1,IBLEN))) + FOUBUF_IN(1)=0._JPRB ! force allocation here + ENDIF +ELSE + ALLOCATE(FOUBUF_IN(MAX(1,IBLEN))) + FOUBUF_IN(1)=0._JPRB ! force allocation here +ENDIF + +CALL GSTATS(1640,0) +!$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) PRIVATE(JGL,IGL) +DO JGL=1,D%NDGL_FS + IGL = JGL + IF(KF_FS>0) THEN + CALL FTDIR(ZGTF,KF_FS,IGL) + ENDIF + +! Save Fourier data in FOUBUF_IN + + CALL FOURIER_OUT(ZGTF,KF_FS,IGL) +ENDDO +!$OMP END PARALLEL DO +CALL GSTATS(1640,1) +CALL GSTATS(106,1) +IF (LHOOK) CALL DR_HOOK('EFTDIR_CTL_MOD:EFTDIR_CTL',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE EFTDIR_CTL +END MODULE EFTDIR_CTL_MOD diff --git a/src/etrans/etrans/internal/eftdir_ctlad_mod.F90 b/src/etrans/etrans/internal/eftdir_ctlad_mod.F90 new file mode 100644 index 000000000..09483e0a4 --- /dev/null +++ b/src/etrans/etrans/internal/eftdir_ctlad_mod.F90 @@ -0,0 +1,201 @@ +MODULE EFTDIR_CTLAD_MOD +CONTAINS +SUBROUTINE EFTDIR_CTLAD(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS,KF_GPB, & + & KVSETUV,KVSETSC,KPTRGP,& + & KVSETSC3A,KVSETSC3B,KVSETSC2,& + & PGP,PGPUV,PGP3A,PGP3B,PGP2) + +!**** *EFTDIR_CTLAD - Direct Fourier transform control - adjoint + +! Purpose. Control routine for Grid-point to Fourier transform +! -------- + +!** Interface. +! ---------- +! CALL EFTDIR_CTLAD(..) + +! Explicit arguments : +! -------------------- +! KF_UV_G - global number of spectral u-v fields +! KF_SCALARS_G - global number of scalar spectral fields +! KF_GP - total number of output gridpoint fields +! KF_FS - total number of fields in fourier space +! PGP - gridpoint array +! KVSETUV - "B" set in spectral/fourier space for +! u and v variables +! KVSETSC - "B" set in spectral/fourier space for +! scalar variables +! KPTRGP - pointer array to fields in gridpoint space + +! Method. +! ------- + +! Externals. TRGTOL - transposition routine +! ---------- FOURIER_OUT - copy fourier data to Fourier buffer +! EFTDIRAD - fourier transform + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-03-03 +! 01-08-28 : G. Radnoti & R. El Khatib Fix for NPROMATR /= 0 +! 19-11-01 G. Radnoti bug correction by introducing CPL_INT interface +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! R. El Khatib 05-03-15 remove HLOMP +! D. Degrauwe (Feb 2012): Alternative extension zone (E') +! R. El Khatib 09-Sep-2020 NSTACK_MEMORY_TR +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_GEN ,ONLY : NSTACK_MEMORY_TR +USE TPM_DISTR ,ONLY : D + +USE TRLTOG_MOD ,ONLY : TRLTOG +USE FOURIER_OUTAD_MOD ,ONLY : FOURIER_OUTAD +USE EFTDIRAD_MOD ,ONLY : EFTDIRAD +! + +IMPLICIT NONE + +! Dummy arguments + +INTEGER(KIND=JPIM),INTENT(IN) :: KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS,KF_GPB +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETUV(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC3A(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC3B(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC2(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KPTRGP(:) +REAL(KIND=JPRB),OPTIONAL , INTENT(OUT) :: PGP(:,:,:) +REAL(KIND=JPRB),OPTIONAL , INTENT(OUT) :: PGPUV(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL , INTENT(OUT) :: PGP3A(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL , INTENT(OUT) :: PGP3B(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL , INTENT(OUT) :: PGP2(:,:,:) + +! Local variables +REAL(KIND=JPRB),TARGET :: ZGTF_STACK(KF_FS*MIN(1,MAX(0,NSTACK_MEMORY_TR)),D%NLENGTF) +REAL(KIND=JPRB),TARGET, ALLOCATABLE :: ZGTF_HEAP(:,:) +REAL(KIND=JPRB),POINTER :: ZGTF(:,:) + +INTEGER(KIND=JPIM) :: IST +INTEGER(KIND=JPIM) :: IVSETUV(KF_UV_G) +INTEGER(KIND=JPIM) :: IVSETSC(KF_SCALARS_G) +INTEGER(KIND=JPIM) :: IVSET(KF_GP) +INTEGER(KIND=JPIM) :: JGL,IGL,J1,J2 +INTEGER(KIND=JPIM) :: IFGP2,IFGP3A,IFGP3B,IOFF,J3 +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +! Field distribution in Spectral/Fourier space + +IF (LHOOK) CALL DR_HOOK('EFTDIR_CTLAD_MOD:EFTDIR_CTLAD',0,ZHOOK_HANDLE) +CALL GSTATS(133,0) + +IF (NSTACK_MEMORY_TR == 1) THEN + ZGTF => ZGTF_STACK(:,:) +ELSE + ALLOCATE(ZGTF_HEAP(KF_FS,D%NLENGTF)) + ZGTF => ZGTF_HEAP(:,:) +ENDIF + +ZGTF(:,:)=0._JPRB + +IF(PRESENT(KVSETUV)) THEN + IVSETUV(:) = KVSETUV(:) +ELSE + IVSETUV(:) = -1 +ENDIF +IF(PRESENT(KVSETSC)) THEN + IVSETSC(:) = KVSETSC(:) +ELSE + IVSETSC(:) = -1 +ENDIF +IST = 1 +IF(KF_UV_G > 0) THEN + IVSET(IST:IST+KF_UV_G-1) = IVSETUV(:) + IST = IST+KF_UV_G + IVSET(IST:IST+KF_UV_G-1) = IVSETUV(:) + IST = IST+KF_UV_G +ENDIF +IF(KF_SCALARS_G > 0) THEN + IVSET(IST:IST+KF_SCALARS_G-1) = IVSETSC(:) + IST = IST+KF_SCALARS_G +ENDIF + +CALL GSTATS(1642,0) +!$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) PRIVATE(JGL,IGL) +DO JGL=1,D%NDGL_FS + IGL = JGL + CALL FOURIER_OUTAD(ZGTF,KF_FS,IGL) + +! Fourier transform + + IF(KF_FS>0) THEN + CALL EFTDIRAD(ZGTF,KF_FS,IGL) + ENDIF +ENDDO +!$OMP END PARALLEL DO +CALL GSTATS(1642,1) +CALL GSTATS(133,1) + +! Transposition + +CALL GSTATS(183,0) +IF(PRESENT(KVSETUV)) THEN + IVSETUV(:) = KVSETUV(:) +ELSE + IVSETUV(:) = -1 +ENDIF +IVSETSC(:) = -1 +IF(PRESENT(KVSETSC)) THEN + IVSETSC(:) = KVSETSC(:) +ELSE + IOFF=0 + IF(PRESENT(KVSETSC2)) THEN + IFGP2=UBOUND(KVSETSC2,1) + IVSETSC(1:IFGP2)=KVSETSC2(:) + IOFF=IOFF+IFGP2 + ENDIF + IF(PRESENT(KVSETSC3A)) THEN + IFGP3A=UBOUND(KVSETSC3A,1) + DO J3=1,UBOUND(PGP3A,3) + IVSETSC(IOFF+1:IOFF+IFGP3A)=KVSETSC3A(:) + IOFF=IOFF+IFGP3A + ENDDO + ENDIF + IF(PRESENT(KVSETSC3B)) THEN + IFGP3B=UBOUND(KVSETSC3B,1) + DO J3=1,UBOUND(PGP3B,3) + IVSETSC(IOFF+1:IOFF+IFGP3B)=KVSETSC3B(:) + IOFF=IOFF+IFGP3B + ENDDO + ENDIF +ENDIF + +IST = 1 +IF(KF_UV_G > 0) THEN + IVSET(IST:IST+KF_UV_G-1) = IVSETUV(:) + IST = IST+KF_UV_G + IVSET(IST:IST+KF_UV_G-1) = IVSETUV(:) + IST = IST+KF_UV_G +ENDIF +IF(KF_SCALARS_G > 0) THEN + IVSET(IST:IST+KF_SCALARS_G-1) = IVSETSC(:) + IST = IST+KF_SCALARS_G +ENDIF +CALL TRLTOG(ZGTF,KF_FS,KF_GP,KF_SCALARS_G,IVSET,KPTRGP,& + & PGP,PGPUV,PGP3A,PGP3B,PGP2) + +CALL GSTATS(183,1) +IF (LHOOK) CALL DR_HOOK('EFTDIR_CTLAD_MOD:EFTDIR_CTLAD',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE EFTDIR_CTLAD +END MODULE EFTDIR_CTLAD_MOD diff --git a/src/etrans/etrans/internal/eftdirad_mod.F90 b/src/etrans/etrans/internal/eftdirad_mod.F90 new file mode 100644 index 000000000..10a7f2259 --- /dev/null +++ b/src/etrans/etrans/internal/eftdirad_mod.F90 @@ -0,0 +1,119 @@ +MODULE EFTDIRAD_MOD +CONTAINS +SUBROUTINE EFTDIRAD(PREEL,KFIELDS,KGL) + +!**** *EFTDIRAD - Direct Fourier transform + +! Purpose. Routine for Grid-point to Fourier transform - adjoint +! -------- + +!** Interface. +! ---------- +! CALL EFTDIRAD(..) + +! Explicit arguments : PREEL - Fourier/grid-point array +! -------------------- KFIELDS - number of fields + +! Method. +! ------- + +! Externals. FFT992 - FFT routine +! ---------- + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-03-03 +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! R. El Khatib 01-Sep-2015 support for FFTW transforms +! R. El Khatib 08-Jun-2023 LALL_FFTW for better flexibility +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM, JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_DISTR ,ONLY : D, MYSETW +!USE TPM_TRANS +USE TPM_GEOMETRY ,ONLY : G +USE TPM_FFT ,ONLY : T, TB +USE BLUESTEIN_MOD ,ONLY : BLUESTEIN_FFT +#ifdef WITH_FFTW +USE TPM_FFTW ,ONLY : TW, EXEC_FFTW +#endif +USE TPM_DIM ,ONLY : R +USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS + +IMPLICIT NONE + +INTEGER(KIND=JPIM),INTENT(IN) :: KFIELDS,KGL +REAL(KIND=JPRB), INTENT(INOUT) :: PREEL(:,:) + +INTEGER(KIND=JPIM) :: IGLG,IST,ILEN,IJUMP,JJ,JF,ILOEN +INTEGER(KIND=JPIM) :: IOFF,IRLEN,ICLEN,ITYPE +REAL(KIND=JPRB) :: ZNORM +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE +! ------------------------------------------------------------------ + +IF (LHOOK) CALL DR_HOOK('EFTDIRAD_MOD:EFTDIRAD',0,ZHOOK_HANDLE) + +ITYPE = 1 +IJUMP = 1 +IGLG = D%NPTRLS(MYSETW)+KGL-1 +ILOEN = G%NLOEN(IGLG) +IST = 2*(G%NMEN(IGLG)+1)+1 +ILEN = ILOEN+3-IST +IOFF = D%NSTAGTF(KGL)+1 + +DO JJ=1,ILEN + DO JF=1,KFIELDS + PREEL(JF,IST+IOFF-1+JJ-1) = 0.0_JPRB + ENDDO +ENDDO +DO JJ=1,1 + DO JF=1,KFIELDS + PREEL(JF,IOFF-1+JJ) = 2.0_JPRB * PREEL(JF,IOFF-1+JJ) + ENDDO +ENDDO + +#ifdef WITH_FFTW +IF( .NOT. TW%LFFTW )THEN +#endif + + IF( T%LUSEFFT992(KGL) )THEN + + CALL FFT992(PREEL(1,IOFF),T%TRIGS(1,KGL),& + &T%NFAX(1,KGL),KFIELDS,IJUMP,ILOEN,KFIELDS,ITYPE) + + ELSE + + CALL BLUESTEIN_FFT(TB,ILOEN,ITYPE,KFIELDS,PREEL(1:KFIELDS,IOFF:IOFF+ICLEN-1)) + + ENDIF + +#ifdef WITH_FFTW +ELSE + + IRLEN=G%NLOEN(IGLG)+R%NNOEXTZL + ICLEN=(IRLEN/2+1)*2 + CALL EXEC_FFTW(ITYPE,IRLEN,ICLEN,IOFF,KFIELDS,TW%LALL_FFTW,PREEL) + +ENDIF +#endif + + + ! Change of metric (not in forward routine) +ZNORM=1.0_JPRB/(2.0_JPRB*REAL(ILOEN,JPRB)) +DO JJ=1,ILOEN + DO JF=1,KFIELDS + PREEL(JF,IOFF-1+JJ) = ZNORM * PREEL(JF,IOFF-1+JJ) + ENDDO +ENDDO +IF (LHOOK) CALL DR_HOOK('EFTDIRAD_MOD:EFTDIRAD',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE EFTDIRAD +END MODULE EFTDIRAD_MOD diff --git a/src/etrans/etrans/internal/eftinv_ctl_mod.F90 b/src/etrans/etrans/internal/eftinv_ctl_mod.F90 new file mode 100644 index 000000000..3dd9d5352 --- /dev/null +++ b/src/etrans/etrans/internal/eftinv_ctl_mod.F90 @@ -0,0 +1,273 @@ +MODULE EFTINV_CTL_MOD +CONTAINS +SUBROUTINE EFTINV_CTL(KF_UV_G,KF_SCALARS_G,& + & KF_UV,KF_SCALARS,KF_SCDERS,KF_GP,KF_FS,KF_OUT_LT,KVSETUV,KVSETSC,KPTRGP, & + & KVSETSC3A,KVSETSC3B,KVSETSC2,& + & PGP,PGPUV,PGP3A,PGP3B,PGP2) + +!**** *EFTINV_CTL - Inverse Fourier transform control + +! Purpose. Control routine for Fourier to Gridpoint transform +! -------- + +!** Interface. +! ---------- +! CALL EFTINV_CTL(..) + +! Explicit arguments : +! -------------------- +! PGP - gridpoint array +! KF_UV_G - global number of spectral u-v fields +! KF_SCALARS_G - global number of scalar spectral fields +! KF_UV - local number of spectral u-v fields +! KF_SCALARS - local number of scalar spectral fields +! KF_SCDERS - local number of derivatives of scalar spectral fields +! KF_GP - total number of output gridpoint fields +! KF_FS - total number of fields in fourier space +! KF_OUT_LT - total number of fields coming out from inverse LT +! KVSETUV - "B" set in spectral/fourier space for +! u and v variables +! KVSETSC - "B" set in spectral/fourier space for +! scalar variables +! KPTRGP - pointer array to fi3elds in gridpoint space + +! Method. +! ------- + +! Externals. TRLTOG - transposition routine +! ---------- FOURIER_IN - copy fourier data from Fourier buffer +! FTINV - fourier transform +! FSC - Fourier space computations + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-03-03 +! G. Hello : 03-10-14 old way of calling +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! O.Spaniel Oct-2004 phasing for AL29 +! D. Degrauwe (Feb 2012): Alternative extension zone (E') +! R. El Khatib 09-Sep-2020 NSTACK_MEMORY_TR +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_GEN ,ONLY : NERR ,NSTACK_MEMORY_TR +USE TPM_TRANS ,ONLY : LDIVGP, LSCDERS, LUVDER, LVORGP +USE TPM_DISTR ,ONLY : D + +USE FOURIER_IN_MOD ,ONLY : FOURIER_IN +USE EFSC_MOD ,ONLY : EFSC +USE FTINV_MOD ,ONLY : FTINV +USE TRLTOG_MOD ,ONLY : TRLTOG +USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS +! + +IMPLICIT NONE + +INTEGER(KIND=JPIM) ,INTENT(IN) :: KF_UV_G +INTEGER(KIND=JPIM) ,INTENT(IN) :: KF_SCALARS_G +INTEGER(KIND=JPIM) ,INTENT(IN) :: KF_UV +INTEGER(KIND=JPIM) ,INTENT(IN) :: KF_SCALARS +INTEGER(KIND=JPIM) ,INTENT(IN) :: KF_SCDERS +INTEGER(KIND=JPIM) ,INTENT(IN) :: KF_GP +INTEGER(KIND=JPIM) ,INTENT(IN) :: KF_FS +INTEGER(KIND=JPIM) ,INTENT(IN) :: KF_OUT_LT +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETUV(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC3A(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC3B(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC2(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KPTRGP(:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PGP(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PGPUV(:,:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PGP3A(:,:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PGP3B(:,:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PGP2(:,:,:) + +REAL(KIND=JPRB),TARGET :: ZGTF_STACK(KF_FS*MIN(1,MAX(0,NSTACK_MEMORY_TR)),D%NLENGTF) +REAL(KIND=JPRB),TARGET, ALLOCATABLE :: ZGTF_HEAP(:,:) +REAL(KIND=JPRB),POINTER :: ZGTF(:,:) +REAL(KIND=JPRB),TARGET :: ZDUM(1,D%NLENGTF) +REAL(KIND=JPRB),POINTER :: ZUV(:,:) +REAL(KIND=JPRB),POINTER :: ZSCALAR(:,:) +REAL(KIND=JPRB),POINTER :: ZNSDERS(:,:) +REAL(KIND=JPRB),POINTER :: ZEWDERS(:,:) +REAL(KIND=JPRB),POINTER :: ZUVDERS(:,:) + +INTEGER(KIND=JPIM) :: IST +INTEGER(KIND=JPIM) :: IVSETUV(KF_UV_G) +INTEGER(KIND=JPIM) :: IVSETSC(KF_SCALARS_G) +INTEGER(KIND=JPIM) :: IVSET(KF_GP) +INTEGER(KIND=JPIM) :: J3,JGL,IGL,IOFF,IFGP2,IFGP3A,IFGP3B,IGP3APAR,IGP3BPAR +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +! 1. Copy Fourier data to local array + +IF (LHOOK) CALL DR_HOOK('EFTINV_CTL_MOD:EFTINV_CTL',0,ZHOOK_HANDLE) +CALL GSTATS(107,0) + +IF (NSTACK_MEMORY_TR == 1) THEN + ZGTF => ZGTF_STACK(:,:) +ELSE + ALLOCATE(ZGTF_HEAP(KF_FS,D%NLENGTF)) +! Now, force the OS to allocate this shared array right now, not when it starts +! to be used which is an OPEN-MP loop, that would cause a threads synchronization lock : + IF (KF_FS > 0 .AND. D%NLENGTF > 0) THEN + ZGTF_HEAP(1,1)=HUGE(1._JPRB) + ENDIF + ZGTF => ZGTF_HEAP(:,:) +ENDIF + +IF(KF_UV > 0 .OR. KF_SCDERS > 0) THEN + IST = 1 + IF(LVORGP) THEN + IST = IST+KF_UV + ENDIF + IF(LDIVGP) THEN + IST = IST+KF_UV + ENDIF + ZUV => ZGTF(IST:IST+2*KF_UV-1,:) + IST = IST+2*KF_UV + ZSCALAR => ZGTF(IST:IST+KF_SCALARS-1,:) + IST = IST+KF_SCALARS + ZNSDERS => ZGTF(IST:IST+KF_SCDERS-1,:) + IST = IST+KF_SCDERS + IF(LUVDER) THEN + ZUVDERS => ZGTF(IST:IST+2*KF_UV-1,:) + IST = IST+2*KF_UV + ELSE + ZUVDERS => ZDUM(1:1,:) + ENDIF + IF(KF_SCDERS > 0) THEN + ZEWDERS => ZGTF(IST:IST+KF_SCDERS-1,:) + ELSE + ZEWDERS => ZDUM(1:1,:) + ENDIF +ENDIF + +CALL GSTATS(1639,0) +!$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) PRIVATE(JGL,IGL) +DO JGL=1,D%NDGL_FS + IGL = JGL + CALL FOURIER_IN(ZGTF,KF_OUT_LT,IGL) + +! 2. Fourier space computations + + IF(KF_UV > 0 .OR. KF_SCDERS > 0) THEN + CALL EFSC(IGL,KF_UV,KF_SCALARS,KF_SCDERS,& + & ZUV,ZSCALAR,ZNSDERS,ZEWDERS,ZUVDERS) + ENDIF + +! 3. Fourier transform + IF(KF_FS > 0) THEN + CALL FTINV(ZGTF,KF_FS,IGL) + ENDIF +ENDDO +!$OMP END PARALLEL DO +CALL GSTATS(1639,1) + +IF(KF_UV > 0 .OR. KF_SCDERS > 0) THEN + NULLIFY(ZUV) + NULLIFY(ZSCALAR) + NULLIFY(ZNSDERS) + NULLIFY(ZUVDERS) + NULLIFY(ZEWDERS) +ENDIF +CALL GSTATS(107,1) + +! 4. Transposition + +IF(PRESENT(KVSETUV)) THEN + IVSETUV(:) = KVSETUV(:) +ELSE + IVSETUV(:) = -1 +ENDIF +IVSETSC(:)=-1 +IF(PRESENT(KVSETSC)) THEN + IVSETSC(:) = KVSETSC(:) +ELSEIF(PRESENT(KVSETSC2).OR.PRESENT(KVSETSC3A)& + & .OR.PRESENT(KVSETSC3B)) THEN + IOFF=0 + IF(PRESENT(KVSETSC2)) THEN + IFGP2=UBOUND(KVSETSC2,1) + IVSETSC(1:IFGP2)=KVSETSC2(:) + IOFF=IOFF+IFGP2 + ENDIF + IF(PRESENT(KVSETSC3A)) THEN + IFGP3A=UBOUND(KVSETSC3A,1) + IGP3APAR=UBOUND(PGP3A,3) + IF(LSCDERS) IGP3APAR=IGP3APAR/3 + DO J3=1,IGP3APAR + IVSETSC(IOFF+1:IOFF+IFGP3A)=KVSETSC3A(:) + IOFF=IOFF+IFGP3A + ENDDO + ENDIF + IF(PRESENT(KVSETSC3B)) THEN + IFGP3B=UBOUND(KVSETSC3B,1) + IGP3BPAR=UBOUND(PGP3B,3) + IF(LSCDERS) IGP3BPAR=IGP3BPAR/3 + DO J3=1,IGP3BPAR + IVSETSC(IOFF+1:IOFF+IFGP3B)=KVSETSC3B(:) + IOFF=IOFF+IFGP3B + ENDDO + ENDIF + IF(IOFF > 0 .AND. IOFF /= KF_SCALARS_G ) THEN + WRITE(NERR,*)'FTINV:IOFF,KF_SCALARS_G ',IOFF,KF_SCALARS_G + CALL ABORT_TRANS('FTINV_CTL_MOD:IOFF /= KF_SCALARS_G') + ENDIF +ENDIF + +IST = 1 +IF(KF_UV_G > 0) THEN + IF( LVORGP) THEN + IVSET(IST:IST+KF_UV_G-1) = IVSETUV(:) + IST = IST+KF_UV_G + ENDIF + IF( LDIVGP) THEN + IVSET(IST:IST+KF_UV_G-1) = IVSETUV(:) + IST = IST+KF_UV_G + ENDIF + IVSET(IST:IST+KF_UV_G-1) = IVSETUV(:) + IST = IST+KF_UV_G + IVSET(IST:IST+KF_UV_G-1) = IVSETUV(:) + IST = IST+KF_UV_G +ENDIF +IF(KF_SCALARS_G > 0) THEN + IVSET(IST:IST+KF_SCALARS_G-1) = IVSETSC(:) + IST = IST+KF_SCALARS_G + IF(LSCDERS) THEN + IVSET(IST:IST+KF_SCALARS_G-1) = IVSETSC(:) + IST = IST+KF_SCALARS_G + ENDIF +ENDIF +IF(KF_UV_G > 0 .AND. LUVDER) THEN + IVSET(IST:IST+KF_UV_G-1) = IVSETUV(:) + IST = IST+KF_UV_G + IVSET(IST:IST+KF_UV_G-1) = IVSETUV(:) + IST = IST+KF_UV_G +ENDIF +IF(KF_SCALARS_G > 0) THEN + IF(LSCDERS) THEN + IVSET(IST:IST+KF_SCALARS_G-1) = IVSETSC(:) + IST = IST+KF_SCALARS_G + ENDIF +ENDIF + +CALL GSTATS(157,0) +CALL TRLTOG(ZGTF,KF_FS,KF_GP,KF_SCALARS_G,IVSET,KPTRGP,& + & PGP,PGPUV,PGP3A,PGP3B,PGP2) +CALL GSTATS(157,1) + +IF (LHOOK) CALL DR_HOOK('EFTINV_CTL_MOD:EFTINV_CTL',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE EFTINV_CTL +END MODULE EFTINV_CTL_MOD diff --git a/src/etrans/etrans/internal/eftinv_ctlad_mod.F90 b/src/etrans/etrans/internal/eftinv_ctlad_mod.F90 new file mode 100644 index 000000000..fd1fc5e57 --- /dev/null +++ b/src/etrans/etrans/internal/eftinv_ctlad_mod.F90 @@ -0,0 +1,295 @@ +MODULE EFTINV_CTLAD_MOD +CONTAINS +SUBROUTINE EFTINV_CTLAD(KF_UV_G,KF_SCALARS_G,& + & KF_UV,KF_SCALARS,KF_SCDERS,KF_GP,KF_FS,KF_OUT_LT,KVSETUV,KVSETSC,KPTRGP, & + & KVSETSC3A,KVSETSC3B,KVSETSC2,& + & PGP,PGPUV,PGP3A,PGP3B,PGP2) + +!**** *EFTINV_CTLAD - Inverse Fourier transform control - adjoint + +! Purpose. Control routine for Fourier to Gridpoint transform +! -------- + +!** Interface. +! ---------- +! CALL EFTINV_CTLAD(..) + +! Explicit arguments : +! -------------------- +! PGP - gridpoint array +! KF_UV_G - global number of spectral u-v fields +! KF_SCALARS_G - global number of scalar spectral fields +! KF_UV - local number of spectral u-v fields +! KF_SCALARS - local number of scalar spectral fields +! KF_SCDERS - local number of derivatives of scalar spectral fields +! KF_GP - total number of output gridpoint fields +! KF_FS - total number of fields in fourier space +! KF_OUT_LT - total number of fields coming out from inverse LT +! KVSETUV - "B" set in spectral/fourier space for +! u and v variables +! KVSETSC - "B" set in spectral/fourier space for +! scalar variables +! KPTRGP - pointer array to fi3elds in gridpoint space + +! Method. +! ------- + +! Externals. TRLTOG - transposition routine +! ---------- FOURIER_IN - copy fourier data from Fourier buffer +! FTINV - fourier transform +! FSC - Fourier space computations + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-03-03 +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! D. Degrauwe (Feb 2012): Alternative extension zone (E') +! R. El Khatib 09-Sep-2020 NSTACK_MEMORY_TR +! R. El Khatib 02-Jun-2022 Optimization/Cleaning +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_GEN ,ONLY : NERR ,NSTACK_MEMORY_TR +USE TPM_DIM ,ONLY : R +USE TPM_TRANS ,ONLY : FOUBUF, LDIVGP, LSCDERS, LUVDER, LVORGP +USE TPM_DISTR ,ONLY : D + +USE FOURIER_INAD_MOD ,ONLY : FOURIER_INAD +USE EFSCAD_MOD ,ONLY : EFSCAD +USE EFTINVAD_MOD ,ONLY : EFTINVAD +USE TRGTOL_MOD ,ONLY : TRGTOL +USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS + +USE EXTPER_MOD ,ONLY : EXTPER +! + +IMPLICIT NONE + +INTEGER(KIND=JPIM) ,INTENT(IN) :: KF_UV_G +INTEGER(KIND=JPIM) ,INTENT(IN) :: KF_SCALARS_G +INTEGER(KIND=JPIM) ,INTENT(IN) :: KF_UV +INTEGER(KIND=JPIM) ,INTENT(IN) :: KF_SCALARS +INTEGER(KIND=JPIM) ,INTENT(IN) :: KF_SCDERS +INTEGER(KIND=JPIM) ,INTENT(IN) :: KF_GP +INTEGER(KIND=JPIM) ,INTENT(IN) :: KF_FS +INTEGER(KIND=JPIM) ,INTENT(IN) :: KF_OUT_LT +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETUV(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC3A(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC3B(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC2(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KPTRGP(:) +REAL(KIND=JPRB),OPTIONAL , INTENT(IN) :: PGP(:,:,:) +REAL(KIND=JPRB),OPTIONAL , INTENT(IN) :: PGPUV(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL , INTENT(IN) :: PGP3A(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL , INTENT(IN) :: PGP3B(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL , INTENT(IN) :: PGP2(:,:,:) + +! ------------------------------------------------------------------ + +REAL(KIND=JPRB),TARGET :: ZGTF_STACK(KF_FS*MIN(1,MAX(0,NSTACK_MEMORY_TR)),D%NLENGTF) +REAL(KIND=JPRB),TARGET, ALLOCATABLE :: ZGTF_HEAP(:,:) +REAL(KIND=JPRB),POINTER :: ZGTF(:,:) +REAL(KIND=JPRB),TARGET :: ZDUM(1,D%NLENGTF) +REAL(KIND=JPRB),POINTER :: ZUV(:,:) +REAL(KIND=JPRB),POINTER :: ZSCALAR(:,:) +REAL(KIND=JPRB),POINTER :: ZNSDERS(:,:) +REAL(KIND=JPRB),POINTER :: ZEWDERS(:,:) +REAL(KIND=JPRB),POINTER :: ZUVDERS(:,:) + +INTEGER(KIND=JPIM) :: IST, IBLEN +INTEGER(KIND=JPIM) :: IVSETUV(KF_UV_G) +INTEGER(KIND=JPIM) :: IVSETSC(KF_SCALARS_G) +INTEGER(KIND=JPIM) :: IVSET(KF_GP) +INTEGER(KIND=JPIM) :: J3,JGL,IGL,IOFF,IFGP2,IFGP3A,IFGP3B,IGP3APAR,IGP3BPAR +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +! 4. Transposition + +IF (LHOOK) CALL DR_HOOK('EFTINV_CTLAD_MOD:EFTINV_CTLAD',0,ZHOOK_HANDLE) + +IF (NSTACK_MEMORY_TR == 1) THEN + ZGTF => ZGTF_STACK(:,:) +ELSE + ALLOCATE(ZGTF_HEAP(KF_FS,D%NLENGTF)) + ZGTF => ZGTF_HEAP(:,:) +ENDIF + +ZGTF(:,:)=0._JPRB + +IF(PRESENT(KVSETUV)) THEN + IVSETUV(:) = KVSETUV(:) +ELSE + IVSETUV(:) = -1 +ENDIF + +IVSETSC(:)=-1 +IF(PRESENT(KVSETSC)) THEN + IVSETSC(:) = KVSETSC(:) +ELSE + IOFF=0 + IF(PRESENT(KVSETSC2)) THEN + IFGP2=UBOUND(KVSETSC2,1) + IVSETSC(1:IFGP2)=KVSETSC2(:) + IOFF=IOFF+IFGP2 + ENDIF + IF(PRESENT(KVSETSC3A)) THEN + IFGP3A=UBOUND(KVSETSC3A,1) + IGP3APAR=UBOUND(PGP3A,3) + IF(LSCDERS) IGP3APAR=IGP3APAR/3 + DO J3=1,IGP3APAR + IVSETSC(IOFF+1:IOFF+IFGP3A)=KVSETSC3A(:) + IOFF=IOFF+IFGP3A + ENDDO + ENDIF + IF(PRESENT(KVSETSC3B)) THEN + IFGP3B=UBOUND(KVSETSC3B,1) + IGP3BPAR=UBOUND(PGP3B,3) + IF(LSCDERS) IGP3BPAR=IGP3BPAR/3 + DO J3=1,IGP3BPAR + IVSETSC(IOFF+1:IOFF+IFGP3B)=KVSETSC3B(:) + IOFF=IOFF+IFGP3B + ENDDO + ENDIF + IF(IOFF /= KF_SCALARS_G ) THEN + WRITE(NERR,*)'FTINV_CTLAD:IOFF,KF_SCALARS_G ',IOFF,KF_SCALARS_G + CALL ABORT_TRANS('FTINV_CTLAD_MOD:IOFF /= KF_SCALARS_G') + ENDIF +ENDIF + +IST = 1 +IF(KF_UV_G > 0) THEN + IF( LVORGP) THEN + IVSET(IST:IST+KF_UV_G-1) = IVSETUV(:) + IST = IST+KF_UV_G + ENDIF + IF( LDIVGP) THEN + IVSET(IST:IST+KF_UV_G-1) = IVSETUV(:) + IST = IST+KF_UV_G + ENDIF + IVSET(IST:IST+KF_UV_G-1) = IVSETUV(:) + IST = IST+KF_UV_G + IVSET(IST:IST+KF_UV_G-1) = IVSETUV(:) + IST = IST+KF_UV_G +ENDIF +IF(KF_SCALARS_G > 0) THEN + IVSET(IST:IST+KF_SCALARS_G-1) = IVSETSC(:) + IST = IST+KF_SCALARS_G + IF(LSCDERS) THEN + IVSET(IST:IST+KF_SCALARS_G-1) = IVSETSC(:) + IST = IST+KF_SCALARS_G + ENDIF +ENDIF +IF(KF_UV_G > 0 .AND. LUVDER) THEN + IVSET(IST:IST+KF_UV_G-1) = IVSETUV(:) + IST = IST+KF_UV_G + IVSET(IST:IST+KF_UV_G-1) = IVSETUV(:) + IST = IST+KF_UV_G +ENDIF +IF(KF_SCALARS_G > 0) THEN + IF(LSCDERS) THEN + IVSET(IST:IST+KF_SCALARS_G-1) = IVSETSC(:) + IST = IST+KF_SCALARS_G + ENDIF +ENDIF + +CALL GSTATS(182,0) +CALL TRGTOL(ZGTF,KF_FS,KF_GP,KF_SCALARS_G,IVSET,KPTRGP,& + & PGP,PGPUV,PGP3A,PGP3B,PGP2) +CALL GSTATS(182,1) + +! Periodization of auxiliary fields in x direction +IF(R%NNOEXTZL>0) THEN + CALL EXTPER(ZGTF,R%NDLON+R%NNOEXTZL,1,R%NDLON,KF_FS,D%NDGL_FS,D%NSTAGTF,0) +ENDIF + + +! 3. Fourier transform + +IF(KF_UV > 0 .OR. KF_SCDERS > 0) THEN + IST = 1 + IF(LVORGP) THEN + IST = IST+KF_UV + ENDIF + IF(LDIVGP) THEN + IST = IST+KF_UV + ENDIF + ZUV => ZGTF(IST:IST+2*KF_UV-1,:) + IST = IST+2*KF_UV + ZSCALAR => ZGTF(IST:IST+KF_SCALARS-1,:) + IST = IST+KF_SCALARS + ZNSDERS => ZGTF(IST:IST+KF_SCDERS-1,:) + IST = IST+KF_SCDERS + IF(LUVDER) THEN + ZUVDERS => ZGTF(IST:IST+2*KF_UV-1,:) + IST = IST+2*KF_UV + ELSE + ZUVDERS => ZDUM(1:1,:) + ENDIF + IF(KF_SCDERS > 0) THEN + ZEWDERS => ZGTF(IST:IST+KF_SCDERS-1,:) + ELSE + ZEWDERS => ZDUM(1:1,:) + ENDIF +ENDIF + +IBLEN = D%NLENGT0B*2*KF_OUT_LT +IF (ALLOCATED(FOUBUF)) THEN + IF (MAX(1,IBLEN) > SIZE(FOUBUF)) THEN + DEALLOCATE(FOUBUF) + ALLOCATE(FOUBUF(MAX(1,IBLEN))) + FOUBUF(1)=0._JPRB ! force allocation here + ENDIF +ELSE + ALLOCATE(FOUBUF(MAX(1,IBLEN))) + FOUBUF(1)=0._JPRB ! force allocation here +ENDIF + +CALL GSTATS(132,0) + +CALL GSTATS(1641,0) +!$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) PRIVATE(JGL,IGL) +DO JGL=1,D%NDGL_FS + IGL = JGL + IF(KF_FS > 0) THEN + CALL EFTINVAD(ZGTF,KF_FS,IGL) + ENDIF + +! 2. Fourier space computations + + IF(KF_UV > 0 .OR. KF_SCDERS > 0) THEN + CALL EFSCAD(IGL,KF_UV,KF_SCALARS,KF_SCDERS,& + & ZUV,ZSCALAR,ZNSDERS,ZEWDERS,ZUVDERS) + ENDIF + +! 1. Copy Fourier data to local array + + CALL FOURIER_INAD(ZGTF,KF_OUT_LT,IGL) + +ENDDO +!$OMP END PARALLEL DO +CALL GSTATS(1641,1) + +IF(KF_UV > 0 .OR. KF_SCDERS > 0) THEN + NULLIFY(ZUV) + NULLIFY(ZSCALAR) + NULLIFY(ZNSDERS) + NULLIFY(ZUVDERS) + NULLIFY(ZEWDERS) +ENDIF + +CALL GSTATS(132,1) +IF (LHOOK) CALL DR_HOOK('EFTINV_CTLAD_MOD:EFTINV_CTLAD',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE EFTINV_CTLAD +END MODULE EFTINV_CTLAD_MOD diff --git a/src/etrans/etrans/internal/eftinvad_mod.F90 b/src/etrans/etrans/internal/eftinvad_mod.F90 new file mode 100644 index 000000000..b1c1df4ff --- /dev/null +++ b/src/etrans/etrans/internal/eftinvad_mod.F90 @@ -0,0 +1,128 @@ +MODULE EFTINVAD_MOD +CONTAINS +SUBROUTINE EFTINVAD(PREEL,KFIELDS,KGL) + +!**** *EFTINVAD - Inverse Fourier transform - adjoint + +! Purpose. Routine for Fourier to Grid-point transform +! -------- + +!** Interface. +! ---------- +! CALL EFTINVAD(..) + +! Explicit arguments : PREEL - Fourier/grid-point array +! -------------------- KFIELDS - number of fields + +! Method. +! ------- + +! Externals. FFT992 - FFT routine +! ---------- + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-03-03 +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! D. Degrauwe (Feb 2012): Alternative extension zone (E') +! R. El Khatib 01-Sep-2015 support for FFTW transforms +! R. El Khatib 08-Jun-2023 LALL_FFTW for better flexibility +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM, JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_DISTR ,ONLY : D, MYSETW +USE TPM_DIM ,ONLY : R +USE TPM_GEOMETRY ,ONLY : G +USE TPM_FFT ,ONLY : T, TB +USE BLUESTEIN_MOD ,ONLY : BLUESTEIN_FFT +#ifdef WITH_FFTW +USE TPM_FFTW ,ONLY : TW, EXEC_FFTW +#endif +USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS +! + +IMPLICIT NONE + +INTEGER(KIND=JPIM),INTENT(IN) :: KFIELDS,KGL +REAL(KIND=JPRB), INTENT(OUT) :: PREEL(:,:) + +INTEGER(KIND=JPIM) :: IGLG,IST,ILEN,IJUMP,JJ,JF,ILOEN +INTEGER(KIND=JPIM) :: IOFF,IRLEN,ICLEN,ITYPE + +REAL(KIND=JPRB) :: ZNORM +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +IF (LHOOK) CALL DR_HOOK('EFTINVAD_MOD:EFTINVAD',0,ZHOOK_HANDLE) + +ITYPE =-1 +IJUMP = 1 +IGLG = D%NPTRLS(MYSETW)+KGL-1 +ILOEN = G%NLOEN(IGLG)+R%NNOEXTZL +IST = 2*(G%NMEN(IGLG)+1)+1 +ILEN = ILOEN+3-IST +IOFF = D%NSTAGTF(KGL)+1 + +! ! Change of metric (not in forward routine) + +#ifdef WITH_FFTW +IF( .NOT. TW%LFFTW )THEN +#endif + + IF( T%LUSEFFT992(KGL) )THEN + + CALL FFT992(PREEL(1,IOFF),T%TRIGS(1,KGL),& + &T%NFAX(1,KGL),KFIELDS,IJUMP,ILOEN,KFIELDS,ITYPE) + + ELSE + + CALL BLUESTEIN_FFT(TB,ILOEN,ITYPE,KFIELDS,PREEL(1:KFIELDS,IOFF:IOFF+ICLEN-1)) + DO JJ=1,ICLEN + DO JF=1,KFIELDS + PREEL(JF,IOFF-1+JJ)=PREEL(JF,IOFF-1+JJ)/REAL(ILOEN,JPRB) + ENDDO + ENDDO + + ENDIF + +#ifdef WITH_FFTW +ELSE + + IRLEN=G%NLOEN(IGLG)+R%NNOEXTZL + ICLEN=(IRLEN/2+1)*2 + CALL EXEC_FFTW(ITYPE,IRLEN,ICLEN,IOFF,KFIELDS,TW%LALL_FFTW,PREEL) + +ENDIF +#endif + +ZNORM=2.0_JPRB*REAL(ILOEN,JPRB) +DO JJ=1,1 + DO JF=1,KFIELDS + PREEL(JF,IOFF-1+JJ) = (ZNORM/2.0_JPRB) * PREEL(JF,IOFF-1+JJ) + ENDDO +ENDDO + +DO JJ=3,ILOEN+1 + DO JF=1,KFIELDS + PREEL(JF,IOFF-1+JJ) = ZNORM * PREEL(JF,IOFF-1+JJ) + ENDDO +ENDDO + +DO JJ=1,ILEN + DO JF=1,KFIELDS + PREEL(JF,IST+IOFF-1+JJ-1) = 0.0_JPRB + ENDDO +ENDDO +IF (LHOOK) CALL DR_HOOK('EFTINVAD_MOD:EFTINVAD',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE EFTINVAD +END MODULE EFTINVAD_MOD diff --git a/src/etrans/etrans/internal/egath_spec_control_mod.F90 b/src/etrans/etrans/internal/egath_spec_control_mod.F90 new file mode 100644 index 000000000..c67b315aa --- /dev/null +++ b/src/etrans/etrans/internal/egath_spec_control_mod.F90 @@ -0,0 +1,201 @@ +MODULE EGATH_SPEC_CONTROL_MOD +CONTAINS +SUBROUTINE EGATH_SPEC_CONTROL(PSPECG,KFGATHG,KTO,KVSET,PSPEC,LDIM1_IS_FLD,& + & KSMAX,KSPEC2,KSPEC2_G,KPOSSP,KDIM0G,KCPL2M,LDZA0IP) + +!**** *GATH_SPEC_CONTROL* - Gather global spectral array from processors + +! Purpose. +! -------- +! Routine for gathering spectral array + +!** Interface. +! ---------- +! CALL GATH_SPEC_CONTROL(...) + +! Explicit arguments : +! -------------------- +! PSPECG(:,:) - Global spectral array +! KFGATHG - Global number of fields to be distributed +! KTO(:) - Processor responsible for distributing each field +! KVSET(:) - "B-Set" for each field +! PSPEC(:,:) - Local spectral array + +! ------------------------------------------------------------------ + + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE MPL_MODULE ,ONLY : MPL_RECV, MPL_SEND, MPL_BARRIER, MPL_WAIT, & + & JP_BLOCKING_STANDARD, JP_NON_BLOCKING_STANDARD + +USE TPM_DISTR ,ONLY : MTAGDISTSP, NPRCIDS, NPRTRW, MYSETV, MYPROC, NPROC +USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS +USE SET2PE_MOD ,ONLY : SET2PE + +IMPLICIT NONE + +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPECG(:,:) +INTEGER(KIND=JPIM) , INTENT(IN) :: KFGATHG +INTEGER(KIND=JPIM) , INTENT(IN) :: KTO(:) +INTEGER(KIND=JPIM) , INTENT(IN) :: KVSET(:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPEC(:,:) +LOGICAL ,OPTIONAL, INTENT(IN) :: LDIM1_IS_FLD +INTEGER(KIND=JPIM) , INTENT(IN) :: KSMAX +INTEGER(KIND=JPIM) , INTENT(IN) :: KSPEC2 +INTEGER(KIND=JPIM) , INTENT(IN) :: KSPEC2_G +INTEGER(KIND=JPIM) , INTENT(IN) :: KPOSSP(:) +INTEGER(KIND=JPIM) , INTENT(IN) :: KDIM0G(0:) +INTEGER(KIND=JPIM) , INTENT(IN) :: KCPL2M(0:) +LOGICAL ,OPTIONAL, INTENT(IN) :: LDZA0IP + +REAL(KIND=JPRB) :: ZFLD(KSPEC2,KFGATHG) +REAL(KIND=JPRB),ALLOCATABLE :: ZRECV(:,:) +INTEGER(KIND=JPIM) :: JM,JN,II,IFLDR,IFLDS,JFLD,ITAG,IBSET,ILEN,JA,ISND +INTEGER(KIND=JPIM) :: IRCV,ISP,ILENR,ISTA,ISTP,ISENDREQ(KFGATHG),IPOS0,JNM +INTEGER(KIND=JPIM) :: IDIST(KSPEC2_G),IMYFIELDS + +! ------------------------------------------------------------------ + + +CALL ABORT_TRANS('EGATH_SPEC_CONTROL:DEAD CODE') +!GATHER SPECTRAL ARRAY + +IF( NPROC == 1 ) THEN + CALL GSTATS(1644,0) + IF(LDIM1_IS_FLD) THEN +!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JM,JFLD) + DO JM=1,KSPEC2_G + DO JFLD=1,KFGATHG + PSPECG(JFLD,JM) =PSPEC(JFLD,JM) + ENDDO + ENDDO +!$OMP END PARALLEL DO + ELSE +!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JM,JFLD) + DO JFLD=1,KFGATHG + DO JM=1,KSPEC2_G + PSPECG(JM,JFLD) =PSPEC(JM,JFLD) + ENDDO + ENDDO +!$OMP END PARALLEL DO + ENDIF + CALL GSTATS(1644,1) +ELSE + IMYFIELDS = 0 + DO JFLD=1,KFGATHG + IF(KTO(JFLD) == MYPROC) THEN + IMYFIELDS = IMYFIELDS+1 + ENDIF + ENDDO + IF(IMYFIELDS>0) THEN + ALLOCATE(ZRECV(KSPEC2_G,IMYFIELDS)) + II = 0 + CALL GSTATS(1804,0) + DO JM=0,KSMAX + DO JN=0,KCPL2M(JM)/2-1 + IDIST(II+1) = KDIM0G(JM)+4*JN + IDIST(II+2) = KDIM0G(JM)+4*JN+1 + IDIST(II+3) = KDIM0G(JM)+4*JN+2 + IDIST(II+4) = KDIM0G(JM)+4*JN+3 + II = II+4 + ENDDO + ENDDO + CALL GSTATS(1804,1) + ENDIF + + CALL GSTATS_BARRIER(788) + + !Send + CALL GSTATS(810,0) + IFLDS = 0 + IF(KSPEC2 > 0 )THEN + DO JFLD=1,KFGATHG + + IBSET = KVSET(JFLD) + IF( IBSET == MYSETV )THEN + + IFLDS = IFLDS+1 + ISND = KTO(JFLD) + ITAG = MTAGDISTSP+JFLD+17 + IF(LDIM1_IS_FLD) THEN + ZFLD(1:KSPEC2,IFLDS)=PSPEC(IFLDS,1:KSPEC2) + CALL MPL_SEND(ZFLD(1:KSPEC2,IFLDS),KDEST=NPRCIDS(ISND),KTAG=ITAG,& + &KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=ISENDREQ(JFLD),& + &CDSTRING='GATH_SPEC_CONTROL') + ELSE + CALL MPL_SEND(PSPEC(1:KSPEC2,IFLDS),KDEST=NPRCIDS(ISND),KTAG=ITAG,& + &KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=ISENDREQ(JFLD),& + &CDSTRING='GATH_SPEC_CONTROL') + ENDIF + ENDIF + ENDDO + ENDIF + + ! Recieve + IFLDR = 0 + DO JFLD=1,KFGATHG + IF(KTO(JFLD) == MYPROC) THEN + IBSET = KVSET(JFLD) + IFLDR = IFLDR+1 + DO JA=1,NPRTRW + ILEN = KPOSSP(JA+1)-KPOSSP(JA) + IF( ILEN > 0 )THEN + CALL SET2PE(IRCV,0,0,JA,IBSET) + ITAG = MTAGDISTSP+JFLD+17 + ISTA = KPOSSP(JA) + ISTP = ISTA+ILEN-1 + CALL MPL_RECV(ZRECV(ISTA:ISTP,IFLDR),KSOURCE=NPRCIDS(IRCV),KTAG=ITAG,& + &KMP_TYPE=JP_BLOCKING_STANDARD,KOUNT=ILENR, & + &CDSTRING='GATH_SPEC_CONTROL') + IF( ILENR /= ILEN )THEN + WRITE(0,'("GATH_SPEC_CONTROL: JFLD=",I4," JA=",I4," ILEN=",I10," ILENR=",I10)')& + &JFLD,JA,ILEN,ILENR + CALL ABORT_TRANS('GATH_SPEC_CONTROL:INVALID RECEIVE MESSAGE LENGTH') + ENDIF + ENDIF + ENDDO + ENDIF + ENDDO + + ! Check for completion of sends + IF(KSPEC2 > 0 )THEN + DO JFLD=1,KFGATHG + IBSET = KVSET(JFLD) + IF( IBSET == MYSETV )THEN + CALL MPL_WAIT(ISENDREQ(JFLD), & + & CDSTRING='GATH_GRID_CTL: WAIT') + ENDIF + ENDDO + ENDIF + CALL GSTATS(810,1) + CALL GSTATS_BARRIER2(788) + + CALL GSTATS(1644,0) +!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JFLD,JNM,II,JN,ISP) + DO JFLD=1,IMYFIELDS + IF(LDIM1_IS_FLD) THEN + DO JNM=1,KSPEC2_G + PSPECG(JFLD,JNM) = ZRECV(IDIST(JNM),JFLD) + ENDDO + ELSE + DO JNM=1,KSPEC2_G + PSPECG(JNM,JFLD) = ZRECV(IDIST(JNM),JFLD) + ENDDO + ENDIF + ENDDO +!$OMP END PARALLEL DO + CALL GSTATS(1644,1) + IF(ALLOCATED(ZRECV)) DEALLOCATE(ZRECV) + + !Synchronize processors + CALL GSTATS(785,0) + CALL MPL_BARRIER(CDSTRING='GATH_SPEC_CONTROL:') + CALL GSTATS(785,1) +ENDIF + +! ------------------------------------------------------------------ + +END SUBROUTINE EGATH_SPEC_CONTROL +END MODULE EGATH_SPEC_CONTROL_MOD + + diff --git a/src/etrans/etrans/internal/einv_trans_ctl_mod.F90 b/src/etrans/etrans/internal/einv_trans_ctl_mod.F90 new file mode 100644 index 000000000..fde4b8019 --- /dev/null +++ b/src/etrans/etrans/internal/einv_trans_ctl_mod.F90 @@ -0,0 +1,298 @@ +MODULE EINV_TRANS_CTL_MOD +CONTAINS +SUBROUTINE EINV_TRANS_CTL(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS,KF_OUT_LT,& + & KF_UV,KF_SCALARS,KF_SCDERS,& + & PSPVOR,PSPDIV,PSPSCALAR,KVSETUV,KVSETSC,PGP,FSPGL_PROC,& + & PSPSC3A,PSPSC3B,PSPSC2,KVSETSC3A,KVSETSC3B,KVSETSC2,PGPUV,PGP3A,PGP3B,PGP2,& + & PSPMEANU,PSPMEANV) + +!**** *EINV_TRANS_CTL* - Control routine for inverse spectral transform. + +! Purpose. +! -------- +! Control routine for the inverse spectral transform + +!** Interface. +! ---------- +! CALL EINV_TRANS_CTL(...) + +! Explicit arguments : +! -------------------- +! KF_UV_G - global number of spectral u-v fields +! KF_SCALARS_G - global number of scalar spectral fields +! KF_GP - total number of output gridpoint fields +! KF_FS - total number of fields in fourier space +! KF_OUT_LT - total number of fields coming out from inverse LT +! KF_UV - local number of spectral u-v fields +! KF_SCALARS - local number of scalar spectral fields +! KF_SCDERS - local number of derivatives of scalar spectral fields +! PSPVOR(:,:) - spectral vorticity (input) +! PSPDIV(:,:) - spectral divergence (input) +! PSPSCALAR(:,:) - spectral scalarvalued fields (input) +! KVSETUV(:) - indicating which 'b-set' in spectral space owns a +! vor/div field. Equivalant to NBSETLEV in the IFS. +! The length of KVSETUV should be the GLOBAL number +! of u/v fields which is the dimension of u and v releated +! fields in grid-point space. +! KVESETSC(:) - indicating which 'b-set' in spectral space owns a +! scalar field. As for KVSETUV this argument is required +! if the total number of processors is greater than +! the number of processors used for distribution in +! spectral wave space. +! FSPGL_PROC - external procedure to be executed in fourier space +! before transposition +! PGP(:,:,:) - gridpoint fields (output) + +! The ordering of the output fields is as follows (all +! parts are optional depending on the input switches): + +! vorticity : KF_UV_G fields +! divergence : KF_UV_G fields +! u : KF_UV_G fields +! v : KF_UV_G fields +! scalar fields : KF_SCALARS_G fields +! N-S derivative of scalar fields : KF_SCALARS_G fields +! E-W derivative of u : KF_UV_G fields +! E-W derivative of v : KF_UV_G fields +! E-W derivative of scalar fields : KF_SCALARS_G fields + +! Method. +! ------- + +! Externals. SHUFFLE - reshuffle fields for load balancing +! ---------- FIELD_SPLIT - split fields in NPROMATR packets +! LTINV_CTL - control of Legendre transform +! FTINV_CTL - control of Fourier transform + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 01-01-03 +! M.Hamrud 01-Oct-2003 CY28 Cleaning + +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_GEN ,ONLY : NPROMATR +USE TPM_TRANS ,ONLY : LDIVGP, LSCDERS, LUVDER, LVORGP +!USE TPM_DISTR + +USE SHUFFLE_MOD ,ONLY : SHUFFLE +USE FIELD_SPLIT_MOD ,ONLY : FIELD_SPLIT +USE ELTINV_CTL_MOD ,ONLY : ELTINV_CTL +USE EFTINV_CTL_MOD ,ONLY : EFTINV_CTL +! + +IMPLICIT NONE + +! Declaration of arguments + +INTEGER(KIND=JPIM), INTENT(IN) :: KF_UV_G +INTEGER(KIND=JPIM), INTENT(IN) :: KF_SCALARS_G +INTEGER(KIND=JPIM), INTENT(IN) :: KF_GP +INTEGER(KIND=JPIM), INTENT(IN) :: KF_FS +INTEGER(KIND=JPIM), INTENT(IN) :: KF_OUT_LT +INTEGER(KIND=JPIM), INTENT(IN) :: KF_UV +INTEGER(KIND=JPIM), INTENT(IN) :: KF_SCALARS +INTEGER(KIND=JPIM), INTENT(IN) :: KF_SCDERS +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPVOR(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPDIV(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPSCALAR(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPSC3A(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPSC3B(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPSC2(:,:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETUV(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC3A(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC3B(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC2(:) +REAL(KIND=JPRB) ,OPTIONAL ,INTENT(OUT) :: PGP(:,:,:) +EXTERNAL FSPGL_PROC +OPTIONAL FSPGL_PROC +REAL(KIND=JPRB),OPTIONAL ,INTENT(OUT) :: PGPUV(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL ,INTENT(OUT) :: PGP3A(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL ,INTENT(OUT) :: PGP3B(:,:,:,:) +REAL(KIND=JPRB),OPTIONAL ,INTENT(OUT) :: PGP2(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPMEANU(:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPMEANV(:) + +! Local variables + +INTEGER(KIND=JPIM) :: IPTRGP(KF_GP),IPTRSPUV(NPROMATR),IPTRSPSC(NPROMATR) +INTEGER(KIND=JPIM) :: ISHFUV_G(KF_GP),ISHFSC_G(KF_GP) +INTEGER(KIND=JPIM) :: IVSETUV(KF_GP),IVSETSC(KF_GP) +INTEGER(KIND=JPIM) :: IBLKS,JBLK,ISTUV_G,IENUV_G +INTEGER(KIND=JPIM) :: IF_UV_G,IF_UV,ISTUV,IF_SCALARS,IF_SCALARS_G,IF_FS,IF_GP +INTEGER(KIND=JPIM) :: JFLD,ISTSC_G,IENSC_G,ISTSC,IENSC,IENUV,IF_SCDERS,IF_OUT_LT +INTEGER(KIND=JPIM) :: IOFFD,IOFFU,IOFFV,IOFFUVD,IOFFSC,IOFFSCNS,IOFFSCEW,IOFF,IF_GPB +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +! Perform transform + +IF (LHOOK) CALL DR_HOOK('EINV_TRANS_CTL_MOD:EINV_TRANS_CTL',0,ZHOOK_HANDLE) +IF_GPB = 2*KF_UV_G+KF_SCALARS_G + +IF(NPROMATR > 0 .AND. IF_GPB > NPROMATR) THEN + + ! Fields to be split into packets + + CALL SHUFFLE(KF_UV_G,KF_SCALARS_G,ISHFUV_G,IVSETUV,ISHFSC_G,IVSETSC, & + & KVSETUV,KVSETSC) + + IBLKS=(IF_GPB-1)/NPROMATR+1 + + DO JBLK=1,IBLKS + + CALL FIELD_SPLIT(JBLK,IF_GPB,KF_UV_G,IVSETUV,IVSETSC,& + & ISTUV_G,IENUV_G,IF_UV_G,ISTSC_G,IENSC_G,IF_SCALARS_G,& + & ISTUV,IENUV,IF_UV,ISTSC,IENSC,IF_SCALARS) + + IF(LSCDERS) THEN + IF_SCDERS = IF_SCALARS + ELSE + IF_SCDERS = 0 + ENDIF + + IF_OUT_LT = 2*IF_UV + IF_SCALARS+IF_SCDERS + IF(LVORGP) THEN + IF_OUT_LT = IF_OUT_LT+IF_UV + ENDIF + IF(LDIVGP) THEN + IF_OUT_LT = IF_OUT_LT+IF_UV + ENDIF + IF_FS = IF_OUT_LT+IF_SCDERS + IF(LUVDER) THEN + IF_FS = IF_FS+2*IF_UV + ENDIF + + IF_GP = 2*IF_UV_G+IF_SCALARS_G + IOFFD = 0 + IOFFU = 0 + IOFFV = KF_UV_G + IOFFUVD = 2*KF_UV_G+KF_SCALARS_G + IOFFSC = 2*KF_UV_G + IF(LVORGP) THEN + IF_GP = IF_GP+IF_UV_G + IOFFD = KF_UV_G + IOFFU = IOFFU+KF_UV_G + IOFFV = IOFFV+KF_UV_G + IOFFUVD =IOFFUVD+KF_UV_G + IOFFSC = IOFFSC+KF_UV_G + ENDIF + IF(LDIVGP) THEN + IF_GP = IF_GP+IF_UV_G + IOFFU = IOFFU+KF_UV_G + IOFFV = IOFFV+KF_UV_G + IOFFUVD =IOFFUVD+KF_UV_G + IOFFSC = IOFFSC+KF_UV_G + ENDIF + IF(LSCDERS) THEN + IF_GP = IF_GP+2*IF_SCALARS_G + IOFFUVD =IOFFUVD+KF_SCALARS_G + IOFFSCNS = IOFFSC+KF_SCALARS_G + IOFFSCEW = IOFFSC+2*KF_SCALARS_G + ENDIF + IF(LUVDER) THEN + IF_GP = IF_GP+2*IF_UV_G + IOFFSCEW = IOFFSCEW+2*KF_UV_G + ENDIF + + DO JFLD=1,IF_UV_G + IOFF = 0 + IF(LVORGP) THEN + IPTRGP(JFLD+IOFF) = ISHFUV_G(ISTUV_G+JFLD-1) + IOFF = IOFF+IF_UV_G + ENDIF + IF(LDIVGP) THEN + IPTRGP(JFLD+IOFF) = IOFFD+ISHFUV_G(ISTUV_G+JFLD-1) + IOFF = IOFF+IF_UV_G + ENDIF + IPTRGP(JFLD+IOFF) = IOFFU+ISHFUV_G(ISTUV_G+JFLD-1) + IOFF = IOFF+IF_UV_G + IPTRGP(JFLD+IOFF) = IOFFV+ISHFUV_G(ISTUV_G+JFLD-1) + IOFF = IOFF+IF_UV_G+IF_SCALARS_G + IF(LSCDERS) THEN + IOFF = IOFF+IF_SCALARS_G + ENDIF + IF(LUVDER) THEN + IPTRGP(JFLD+IOFF) = IOFFUVD+ISHFUV_G(ISTUV_G+JFLD-1) + IOFF = IOFF+IF_UV_G + IPTRGP(JFLD+IOFF) = IOFFUVD+KF_UV_G+ISHFUV_G(ISTUV_G+JFLD-1) + ENDIF + ENDDO + + DO JFLD=1,IF_SCALARS_G + IOFF = 2*IF_UV_G + IF (LVORGP) IOFF = IOFF+IF_UV_G + IF (LDIVGP) IOFF = IOFF+IF_UV_G + IPTRGP(JFLD+IOFF) = IOFFSC+ISHFSC_G(ISTSC_G+JFLD-1) + IOFF = IOFF+IF_SCALARS_G + IF(LSCDERS) THEN + IPTRGP(JFLD+IOFF) = IOFFSCNS+ISHFSC_G(ISTSC_G+JFLD-1) + IOFF = IOFF+IF_SCALARS_G + IF(LUVDER) THEN + IOFF = IOFF+2*IF_UV_G + ENDIF + IPTRGP(JFLD+IOFF) = IOFFSCEW+ISHFSC_G(ISTSC_G+JFLD-1) + ENDIF + ENDDO + DO JFLD=1,IF_UV + IPTRSPUV(JFLD) = ISTUV+JFLD-1 + ENDDO + DO JFLD=1,IF_SCALARS + IPTRSPSC(JFLD) = ISTSC+JFLD-1 + ENDDO + + CALL ELTINV_CTL(IF_OUT_LT,IF_UV,IF_SCALARS,IF_SCDERS, & + & PSPVOR=PSPVOR,PSPDIV=PSPDIV,PSPSCALAR=PSPSCALAR,& + & KFLDPTRUV=IPTRSPUV,KFLDPTRSC=IPTRSPSC,& + & PSPMEANU=PSPMEANU,PSPMEANV=PSPMEANV,FSPGL_PROC=FSPGL_PROC) + + IF(IF_UV_G > 0 .AND. IF_SCALARS_G > 0) THEN + CALL EFTINV_CTL(IF_UV_G,IF_SCALARS_G,& + & IF_UV,IF_SCALARS,IF_SCDERS,IF_GP,IF_FS,IF_OUT_LT,& + & KVSETUV=IVSETUV(ISTUV_G:IENUV_G),& + & KVSETSC=IVSETSC(ISTSC_G:IENSC_G),KPTRGP=IPTRGP,& + & PGP=PGP) + ELSEIF(IF_UV_G > 0) THEN + CALL EFTINV_CTL(IF_UV_G,IF_SCALARS_G,& + & IF_UV,IF_SCALARS,IF_SCDERS,IF_GP,IF_FS,IF_OUT_LT,& + & KVSETUV=IVSETUV(ISTUV_G:IENUV_G),KPTRGP=IPTRGP,& + & PGP=PGP) + ELSEIF(IF_SCALARS_G > 0) THEN + CALL EFTINV_CTL(IF_UV_G,IF_SCALARS_G,& + & IF_UV,IF_SCALARS,IF_SCDERS,IF_GP,IF_FS,IF_OUT_LT,& + & KVSETSC=IVSETSC(ISTSC_G:IENSC_G),KPTRGP=IPTRGP,& + & PGP=PGP) + ENDIF + ENDDO + +ELSE + + ! No splitting of fields, transform done in one go + + CALL ELTINV_CTL(KF_OUT_LT,KF_UV,KF_SCALARS,KF_SCDERS, & + & PSPVOR=PSPVOR,PSPDIV=PSPDIV,PSPSCALAR=PSPSCALAR,& + & PSPSC3A=PSPSC3A,PSPSC3B=PSPSC3B,PSPSC2=PSPSC2,& + & PSPMEANU=PSPMEANU,PSPMEANV=PSPMEANV,FSPGL_PROC=FSPGL_PROC) + + CALL EFTINV_CTL(KF_UV_G,KF_SCALARS_G,& + & KF_UV,KF_SCALARS,KF_SCDERS,KF_GP,KF_FS,KF_OUT_LT,& + & KVSETUV=KVSETUV,KVSETSC=KVSETSC,& + & KVSETSC3A=KVSETSC3A,KVSETSC3B=KVSETSC3B,KVSETSC2=KVSETSC2,& + & PGP=PGP,PGPUV=PGPUV,PGP3A=PGP3A,PGP3B=PGP3B,PGP2=PGP2) + +ENDIF +IF (LHOOK) CALL DR_HOOK('EINV_TRANS_CTL_MOD:EINV_TRANS_CTL',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE EINV_TRANS_CTL +END MODULE EINV_TRANS_CTL_MOD diff --git a/src/etrans/etrans/internal/einv_trans_ctlad_mod.F90 b/src/etrans/etrans/internal/einv_trans_ctlad_mod.F90 new file mode 100644 index 000000000..aa00708c2 --- /dev/null +++ b/src/etrans/etrans/internal/einv_trans_ctlad_mod.F90 @@ -0,0 +1,292 @@ +MODULE EINV_TRANS_CTLAD_MOD +CONTAINS +SUBROUTINE EINV_TRANS_CTLAD(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS,KF_OUT_LT,& + & KF_UV,KF_SCALARS,KF_SCDERS,& + & PSPVOR,PSPDIV,PSPSCALAR,KVSETUV,KVSETSC,PGP,& + & PSPSC3A,PSPSC3B,PSPSC2,KVSETSC3A,KVSETSC3B,KVSETSC2,PGPUV,PGP3A,PGP3B,PGP2,& + & PMEANU,PMEANV) + +!**** *EINV_TRANS_CTLAD* - Control routine for inverse spectral transform adj. + +! Purpose. +! -------- +! Control routine for the inverse spectral transform + +!** Interface. +! ---------- +! CALL EINV_TRANS_CTLAD(...) + +! Explicit arguments : +! -------------------- +! KF_UV_G - global number of spectral u-v fields +! KF_SCALARS_G - global number of scalar spectral fields +! KF_GP - total number of output gridpoint fields +! KF_FS - total number of fields in fourier space +! KF_OUT_LT - total number of fields coming out from inverse LT +! KF_UV - local number of spectral u-v fields +! KF_SCALARS - local number of scalar spectral fields +! KF_SCDERS - local number of derivatives of scalar spectral fields +! PSPVOR(:,:) - spectral vorticity (input) +! PSPDIV(:,:) - spectral divergence (input) +! PSPSCALAR(:,:) - spectral scalarvalued fields (input) +! KVSETUV(:) - indicating which 'b-set' in spectral space owns a +! vor/div field. Equivalant to NBSETLEV in the IFS. +! The length of KVSETUV should be the GLOBAL number +! of u/v fields which is the dimension of u and v releated +! fields in grid-point space. +! KVESETSC(:) - indicating which 'b-set' in spectral space owns a +! scalar field. As for KVSETUV this argument is required +! if the total number of processors is greater than +! the number of processors used for distribution in +! spectral wave space. +! PGP(:,:,:) - gridpoint fields (output) + +! The ordering of the output fields is as follows (all +! parts are optional depending on the input switches): + +! vorticity : KF_UV_G fields +! divergence : KF_UV_G fields +! u : KF_UV_G fields +! v : KF_UV_G fields +! scalar fields : KF_SCALARS_G fields +! N-S derivative of scalar fields : KF_SCALARS_G fields +! E-W derivative of u : KF_UV_G fields +! E-W derivative of v : KF_UV_G fields +! E-W derivative of scalar fields : KF_SCALARS_G fields + +! Method. +! ------- + +! Externals. SHUFFLE - reshuffle fields for load balancing +! ---------- FIELD_SPLIT - split fields in NPROMATR packets +! LTINV_CTLAD - control of Legendre transform +! FTINV_CTLAD - control of Fourier transform + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 01-01-03 +! M.Hamrud 01-Oct-2003 CY28 Cleaning + +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_GEN ,ONLY : NPROMATR +USE TPM_TRANS ,ONLY : LDIVGP, LSCDERS, LUVDER, LVORGP +!USE TPM_DISTR + +USE SHUFFLE_MOD ,ONLY : SHUFFLE +USE FIELD_SPLIT_MOD ,ONLY : FIELD_SPLIT +USE ELTINV_CTLAD_MOD ,ONLY : ELTINV_CTLAD +USE EFTINV_CTLAD_MOD ,ONLY : EFTINV_CTLAD +! + +IMPLICIT NONE + +! Declaration of arguments +! +INTEGER(KIND=JPIM), INTENT(IN) :: KF_UV_G +INTEGER(KIND=JPIM), INTENT(IN) :: KF_SCALARS_G +INTEGER(KIND=JPIM), INTENT(IN) :: KF_GP +INTEGER(KIND=JPIM), INTENT(IN) :: KF_FS +INTEGER(KIND=JPIM), INTENT(IN) :: KF_OUT_LT +INTEGER(KIND=JPIM), INTENT(IN) :: KF_UV +INTEGER(KIND=JPIM), INTENT(IN) :: KF_SCALARS +INTEGER(KIND=JPIM), INTENT(IN) :: KF_SCDERS +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPVOR(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPDIV(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPSCALAR(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPSC3A(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPSC3B(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPSC2(:,:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETUV(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC3A(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC3B(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSETSC2(:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PGP(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PGPUV(:,:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PGP3A(:,:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PGP3B(:,:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PGP2(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PMEANU(:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PMEANV(:) + +! Local variables + +INTEGER(KIND=JPIM) :: IPTRGP(KF_GP),IPTRSPUV(NPROMATR),IPTRSPSC(NPROMATR) +INTEGER(KIND=JPIM) :: ISHFUV_G(KF_GP),ISHFSC_G(KF_GP) +INTEGER(KIND=JPIM) :: IVSETUV(KF_GP),IVSETSC(KF_GP) +INTEGER(KIND=JPIM) :: IBLKS,JBLK,ISTUV_G,IENUV_G +INTEGER(KIND=JPIM) :: IF_UV_G,IF_UV,ISTUV,IF_SCALARS,IF_SCALARS_G,IF_FS,IF_GP +INTEGER(KIND=JPIM) :: JFLD,ISTSC_G,IENSC_G,ISTSC,IENSC,IENUV,IF_SCDERS,IF_OUT_LT +INTEGER(KIND=JPIM) :: IOFFD,IOFFU,IOFFV,IOFFUVD,IOFFSC,IOFFSCNS,IOFFSCEW,IOFF,IF_GPB +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +! Perform transform + +IF (LHOOK) CALL DR_HOOK('EINV_TRANS_CTLAD_MOD:EINV_TRANS_CTLAD',0,ZHOOK_HANDLE) +IF_GPB = 2*KF_UV_G+KF_SCALARS_G +IF(NPROMATR > 0 .AND. IF_GPB > NPROMATR) THEN + + ! Fields to be split into packets + + CALL SHUFFLE(KF_UV_G,KF_SCALARS_G,ISHFUV_G,IVSETUV,ISHFSC_G,IVSETSC, & + & KVSETUV,KVSETSC) + + IBLKS=(IF_GPB-1)/NPROMATR+1 + + DO JBLK=1,IBLKS + + CALL FIELD_SPLIT(JBLK,IF_GPB,KF_UV_G,IVSETUV,IVSETSC,& + & ISTUV_G,IENUV_G,IF_UV_G,ISTSC_G,IENSC_G,IF_SCALARS_G,& + & ISTUV,IENUV,IF_UV,ISTSC,IENSC,IF_SCALARS) + + IF(LSCDERS) THEN + IF_SCDERS = IF_SCALARS + ELSE + IF_SCDERS = 0 + ENDIF + + IF_OUT_LT = 2*IF_UV + IF_SCALARS+IF_SCDERS + IF(LVORGP) THEN + IF_OUT_LT = IF_OUT_LT+IF_UV + ENDIF + IF(LDIVGP) THEN + IF_OUT_LT = IF_OUT_LT+IF_UV + ENDIF + IF_FS = IF_OUT_LT+IF_SCDERS + IF(LUVDER) THEN + IF_FS = IF_FS+2*IF_UV + ENDIF + + IF_GP = 2*IF_UV_G+IF_SCALARS_G + IOFFD = 0 + IOFFU = 0 + IOFFV = KF_UV_G + IOFFUVD = 2*KF_UV_G+KF_SCALARS_G + IOFFSC = 2*KF_UV_G + IF(LVORGP) THEN + IF_GP = IF_GP+IF_UV_G + IOFFD = KF_UV_G + IOFFU = IOFFU+KF_UV_G + IOFFV = IOFFV+KF_UV_G + IOFFUVD =IOFFUVD+KF_UV_G + IOFFSC = IOFFSC+KF_UV_G + ENDIF + IF(LDIVGP) THEN + IF_GP = IF_GP+IF_UV_G + IOFFU = IOFFU+KF_UV_G + IOFFV = IOFFV+KF_UV_G + IOFFUVD =IOFFUVD+KF_UV_G + IOFFSC = IOFFSC+KF_UV_G + ENDIF + IF(LSCDERS) THEN + IF_GP = IF_GP+2*IF_SCALARS_G + IOFFUVD =IOFFUVD+KF_SCALARS_G + IOFFSCNS = IOFFSC+KF_SCALARS_G + IOFFSCEW = IOFFSC+2*KF_SCALARS_G + ENDIF + IF(LUVDER) THEN + IF_GP = IF_GP+2*IF_UV_G + IOFFSCEW = IOFFSCEW+2*KF_UV_G + ENDIF + + DO JFLD=1,IF_UV_G + IOFF = 0 + IF(LVORGP) THEN + IPTRGP(JFLD+IOFF) = ISHFUV_G(ISTUV_G+JFLD-1) + IOFF = IOFF+IF_UV_G + ENDIF + IF(LDIVGP) THEN + IPTRGP(JFLD+IOFF) = IOFFD+ISHFUV_G(ISTUV_G+JFLD-1) + IOFF = IOFF+IF_UV_G + ENDIF + IPTRGP(JFLD+IOFF) = IOFFU+ISHFUV_G(ISTUV_G+JFLD-1) + IOFF = IOFF+IF_UV_G + IPTRGP(JFLD+IOFF) = IOFFV+ISHFUV_G(ISTUV_G+JFLD-1) + IOFF = IOFF+IF_UV_G+IF_SCALARS_G + IF(LSCDERS) THEN + IOFF = IOFF+IF_SCALARS_G + ENDIF + IF(LUVDER) THEN + IPTRGP(JFLD+IOFF) = IOFFUVD+ISHFUV_G(ISTUV_G+JFLD-1) + IOFF = IOFF+IF_UV_G + IPTRGP(JFLD+IOFF) = IOFFUVD+KF_UV_G+ISHFUV_G(ISTUV_G+JFLD-1) + ENDIF + ENDDO + + DO JFLD=1,IF_SCALARS_G + IOFF = 2*IF_UV_G + IF (LVORGP) IOFF = IOFF+IF_UV_G + IF (LDIVGP) IOFF = IOFF+IF_UV_G + IPTRGP(JFLD+IOFF) = IOFFSC+ISHFSC_G(ISTSC_G+JFLD-1) + IOFF = IOFF+IF_SCALARS_G + IF(LSCDERS) THEN + IPTRGP(JFLD+IOFF) = IOFFSCNS+ISHFSC_G(ISTSC_G+JFLD-1) + IOFF = IOFF+IF_SCALARS_G + IF(LUVDER) THEN + IOFF = IOFF+2*IF_UV_G + ENDIF + IPTRGP(JFLD+IOFF) = IOFFSCEW+ISHFSC_G(ISTSC_G+JFLD-1) + ENDIF + ENDDO + DO JFLD=1,IF_UV + IPTRSPUV(JFLD) = ISTUV+JFLD-1 + ENDDO + DO JFLD=1,IF_SCALARS + IPTRSPSC(JFLD) = ISTSC+JFLD-1 + ENDDO + + IF(IF_UV_G > 0 .AND. IF_SCALARS_G > 0) THEN + CALL EFTINV_CTLAD(IF_UV_G,IF_SCALARS_G,& + & IF_UV,IF_SCALARS,IF_SCDERS,IF_GP,IF_FS,IF_OUT_LT,& + & KVSETUV=IVSETUV(ISTUV_G:IENUV_G),& + & KVSETSC=IVSETSC(ISTSC_G:IENSC_G),KPTRGP=IPTRGP,& + & PGP=PGP) + ELSEIF(IF_UV_G > 0) THEN + CALL EFTINV_CTLAD(IF_UV_G,IF_SCALARS_G,& + & IF_UV,IF_SCALARS,IF_SCDERS,IF_GP,IF_FS,IF_OUT_LT,& + & KVSETUV=IVSETUV(ISTUV_G:IENUV_G),& + & KPTRGP=IPTRGP,& + & PGP=PGP) + ELSEIF(IF_SCALARS_G > 0) THEN + CALL EFTINV_CTLAD(IF_UV_G,IF_SCALARS_G,& + & IF_UV,IF_SCALARS,IF_SCDERS,IF_GP,IF_FS,IF_OUT_LT,& + & KVSETSC=IVSETSC(ISTSC_G:IENSC_G),KPTRGP=IPTRGP,& + & PGP=PGP) + ENDIF + CALL ELTINV_CTLAD(IF_OUT_LT,IF_UV,IF_SCALARS,IF_SCDERS, & + & PSPVOR=PSPVOR,PSPDIV=PSPDIV,PSPSCALAR=PSPSCALAR,& + & KFLDPTRUV=IPTRSPUV,KFLDPTRSC=IPTRSPSC,& + & PSPMEANU=PMEANU,PSPMEANV=PMEANV) + ENDDO + +ELSE + + ! No splitting of fields, transform done in one go + + CALL EFTINV_CTLAD(KF_UV_G,KF_SCALARS_G,& + & KF_UV,KF_SCALARS,KF_SCDERS,KF_GP,KF_FS,KF_OUT_LT,& + & KVSETUV=KVSETUV,KVSETSC=KVSETSC,& + & KVSETSC3A=KVSETSC3A,KVSETSC3B=KVSETSC3B,KVSETSC2=KVSETSC2,& + & PGP=PGP,PGPUV=PGPUV,PGP3A=PGP3A,PGP3B=PGP3B,PGP2=PGP2) + + CALL ELTINV_CTLAD(KF_OUT_LT,KF_UV,KF_SCALARS,KF_SCDERS, & + & PSPVOR=PSPVOR,PSPDIV=PSPDIV,PSPSCALAR=PSPSCALAR,& + & PSPSC3A=PSPSC3A,PSPSC3B=PSPSC3B,PSPSC2=PSPSC2,& + & PSPMEANU=PMEANU,PSPMEANV=PMEANV ) +ENDIF +IF (LHOOK) CALL DR_HOOK('EINV_TRANS_CTLAD_MOD:EINV_TRANS_CTLAD',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE EINV_TRANS_CTLAD +END MODULE EINV_TRANS_CTLAD_MOD diff --git a/src/etrans/etrans/internal/eledir_mod.F90 b/src/etrans/etrans/internal/eledir_mod.F90 new file mode 100644 index 000000000..12da60d98 --- /dev/null +++ b/src/etrans/etrans/internal/eledir_mod.F90 @@ -0,0 +1,99 @@ +MODULE ELEDIR_MOD +CONTAINS +SUBROUTINE ELEDIR(KM,KFC,KLED2,PFFT) + +!**** *ELEDIR* - Direct meridional transform. + +! Purpose. +! -------- +! Direct meridional tranform of state variables. + +!** Interface. +! ---------- +! CALL ELEDIR(...) + +! Explicit arguments : KM - zonal wavenumber +! -------------------- KFC - number of field to transform +! PAIA - antisymmetric part of Fourier +! fields for zonal wavenumber KM +! PSIA - symmetric part of Fourier +! fields for zonal wavenumber KM +! POA1 - spectral +! fields for zonal wavenumber KM +! PLEPO - Legendre polonomials + +! Implicit arguments : None. +! -------------------- + +! Method. +! ------- + +! Externals. MXMAOP - matrix multiply +! ---------- + +! Reference. +! ---------- +! ECMWF Research Department documentation of the IFS + +! Author. +! ------- +! Mats Hamrud and Philippe Courtier *ECMWF* + +! Modifications. +! -------------- +! Original : 88-01-28 +! Modified : 91-07-01 Philippe Courtier/Mats Hamrud - Rewrite +! for uv formulation +! Modified : 93-03-19 D. Giard - NTMAX instead of NSMAX +! Modified : 04/06/99 D.Salmond : change order of AIA and SIA +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! D. Degrauwe (Feb 2012): Alternative extension zone (E') +! R. El Khatib 01-Sep-2015 support for FFTW transforms +! R. El Khatib 08-Jun-2023 LALL_FFTW for better flexibility +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM, JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK + +USE TPM_DIM ,ONLY : R +!USE TPM_GEOMETRY +!USE TPM_TRANS +USE TPMALD_FFT ,ONLY : TALD +#ifdef WITH_FFTW +USE TPM_FFTW ,ONLY : TW, EXEC_EFFTW +#endif +USE TPMALD_DIM ,ONLY : RALD +USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS +! + +IMPLICIT NONE + +INTEGER(KIND=JPIM), INTENT(IN) :: KM,KFC,KLED2 +REAL(KIND=JPRB) , INTENT(INOUT) :: PFFT(:,:) + +INTEGER(KIND=JPIM) :: IRLEN, ICLEN, IOFF, ITYPE +! ------------------------------------------------------------------ + +!* 1. PERFORM FOURIER TRANFORM. +! -------------------------- + +IF (KFC>0) THEN + ITYPE=-1 + IRLEN=R%NDGL+R%NNOEXTZG + ICLEN=RALD%NDGLSUR+R%NNOEXTZG + IF( TALD%LFFT992 )THEN + CALL FFT992(PFFT,TALD%TRIGSE,TALD%NFAXE,1,ICLEN,IRLEN,KFC,ITYPE) +#ifdef WITH_FFTW + ELSEIF( TW%LFFTW )THEN + IOFF=1 + CALL EXEC_EFFTW(ITYPE,IRLEN,ICLEN,IOFF,KFC,TW%LALL_FFTW,PFFT) +#endif + ELSE + CALL ABORT_TRANS('ELEDIR_MOD:ELEDIR: NO FFT PACKAGE SELECTED') + ENDIF +ENDIF + +! ------------------------------------------------------------------ + +END SUBROUTINE ELEDIR +END MODULE ELEDIR_MOD diff --git a/src/etrans/etrans/internal/eledirad_mod.F90 b/src/etrans/etrans/internal/eledirad_mod.F90 new file mode 100644 index 000000000..19dac6177 --- /dev/null +++ b/src/etrans/etrans/internal/eledirad_mod.F90 @@ -0,0 +1,118 @@ +MODULE ELEDIRAD_MOD +CONTAINS +SUBROUTINE ELEDIRAD(KM,KFC,KLED2,PFFT) + +!**** *ELEDIRAD* - Direct Legendre transform. + +! Purpose. +! -------- +! Direct Legendre tranform of state variables. + +!** Interface. +! ---------- +! CALL ELEDIRAD(...) + +! Explicit arguments : KM - zonal wavenumber +! -------------------- KFC - number of field to transform +! PAIA - antisymmetric part of Fourier +! fields for zonal wavenumber KM +! PSIA - symmetric part of Fourier +! fields for zonal wavenumber KM +! POA1 - spectral +! fields for zonal wavenumber KM +! PLEPO - Legendre polonomials + +! Implicit arguments : None. +! -------------------- + +! Method. +! ------- + +! Externals. MXMAOP - matrix multiply +! ---------- + +! Reference. +! ---------- +! ECMWF Research Department documentation of the IFS + +! Author. +! ------- +! Mats Hamrud and Philippe Courtier *ECMWF* + +! Modifications. +! -------------- +! Original : 88-01-28 +! Modified : 91-07-01 Philippe Courtier/Mats Hamrud - Rewrite +! for uv formulation +! Modified : 93-03-19 D. Giard - NTMAX instead of NSMAX +! Modified : 04/06/99 D.Salmond : change order of AIA and SIA +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! D. Degrauwe (Feb 2012): Alternative extension zone (E') +! R. El Khatib : fix missing support for FFTW +! R. El Khatib 08-Jun-2023 LALL_FFTW for better flexibility +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_DIM ,ONLY : R +!USE TPM_GEOMETRY +!USE TPM_TRANS +#ifdef WITH_FFTW +USE TPM_FFTW ,ONLY : TW, EXEC_EFFTW +#endif +USE TPMALD_FFT ,ONLY : TALD +USE TPMALD_DIM ,ONLY : RALD +USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS +! + +IMPLICIT NONE + +INTEGER(KIND=JPIM), INTENT(IN) :: KM +INTEGER(KIND=JPIM), INTENT(IN) :: KFC +INTEGER(KIND=JPIM), INTENT(IN) :: KLED2 + +REAL(KIND=JPRB), INTENT(INOUT) :: PFFT(:,:) + +INTEGER(KIND=JPIM) :: IRLEN, ICLEN, IOFF, ITYPE +INTEGER(KIND=JPIM) :: JF, JJ +REAL(KIND=JPRB) :: ZNORM +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +IF (LHOOK) CALL DR_HOOK('ELEDIRAD_MOD:ELEDIRAD',0,ZHOOK_HANDLE) + +IF (KFC>0) THEN + DO JJ=1,1 + DO JF=1,KFC + PFFT(JJ,JF) = 2.0_JPRB * PFFT(JJ,JF) + ENDDO + ENDDO + ITYPE=1 + IRLEN=R%NDGL+R%NNOEXTZG + ICLEN=RALD%NDGLSUR+R%NNOEXTZG + IF( TALD%LFFT992 )THEN + CALL FFT992(PFFT,TALD%TRIGSE,TALD%NFAXE,1,RALD%NDGLSUR+R%NNOEXTZG,IRLEN,KFC,ITYPE) +#ifdef WITH_FFTW + ELSEIF( TW%LFFTW )THEN + IOFF=1 + CALL EXEC_EFFTW(ITYPE,IRLEN,ICLEN,IOFF,KFC,TW%LALL_FFTW,PFFT) +#endif + ELSE + CALL ABORT_TRANS('ELEDIR_MOD:ELEDIR: NO FFT PACKAGE SELECTED') + ENDIF + ZNORM=1.0_JPRB/(2.0_JPRB*REAL(R%NDGL+R%NNOEXTZG,JPRB)) + DO JJ=1,R%NDGL+R%NNOEXTZG + DO JF=1,KFC + PFFT(JJ,JF) = ZNORM * PFFT(JJ,JF) + ENDDO + ENDDO +ENDIF + +IF (LHOOK) CALL DR_HOOK('ELEDIRAD_MOD:ELEDIRAD',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE ELEDIRAD +END MODULE ELEDIRAD_MOD diff --git a/src/etrans/etrans/internal/eleinv_mod.F90 b/src/etrans/etrans/internal/eleinv_mod.F90 new file mode 100644 index 000000000..350ca74dc --- /dev/null +++ b/src/etrans/etrans/internal/eleinv_mod.F90 @@ -0,0 +1,103 @@ +MODULE ELEINV_MOD +CONTAINS +SUBROUTINE ELEINV(KM,KFC,KF_OUT_LT,PIA) + +!**** *LEINV* - Inverse Legendre transform. + +! Purpose. +! -------- +! Inverse Legendre tranform of all variables(kernel). + +!** Interface. +! ---------- +! CALL LEINV(...) + +! Explicit arguments : KM - zonal wavenumber (input-c) +! -------------------- KFC - number of fields to tranform (input-c) +! PIA - spectral fields +! for zonal wavenumber KM (input) +! PAOA1 - antisymmetric part of Fourier +! fields for zonal wavenumber KM (output) +! PSOA1 - symmetric part of Fourier +! fields for zonal wavenumber KM (output) +! PLEPO - Legendre polonomials for zonal +! wavenumber KM (input-c) + +! Implicit arguments : None. +! -------------------- + +! Method. +! ------- + +! Externals. MXMAOP - calls SGEMVX (matrix multiply) +! ---------- + +! Reference. +! ---------- +! ECMWF Research Department documentation of the IFS + +! Author. +! ------- +! Mats Hamrud and Philippe Courtier *ECMWF* + +! Modifications. +! -------------- +! Original : 00-02-01 From LEINV in IFS CY22R1 +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! D. Degrauwe (Feb 2012): Alternative extension zone (E') +! R. El Khatib 01-Sep-2015 support for FFTW transforms +! R. El Khatib 08-Jun-2023 LALL_FFTW for better flexibility +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM, JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_DIM ,ONLY : R +!USE TPM_GEOMETRY +!USE TPM_TRANS +#ifdef WITH_FFTW +USE TPM_FFTW ,ONLY : TW, EXEC_EFFTW +#endif +USE TPMALD_DIM ,ONLY : RALD +USE TPMALD_FFT ,ONLY : TALD +USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS +! + +IMPLICIT NONE + +INTEGER(KIND=JPIM), INTENT(IN) :: KM +INTEGER(KIND=JPIM), INTENT(IN) :: KFC +INTEGER(KIND=JPIM), INTENT(IN) :: KF_OUT_LT +REAL(KIND=JPRB), INTENT(INOUT) :: PIA(:,:) + +INTEGER(KIND=JPIM) :: IRLEN, ICLEN, IOFF, ITYPE + +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +!* 1. PERFORM LEGENDRE TRANFORM. +! -------------------------- + +IF (LHOOK) CALL DR_HOOK('ELEINV_MOD:ELEINV',0,ZHOOK_HANDLE) + +IF (KFC>0) THEN + ITYPE=1 + IRLEN=R%NDGL+R%NNOEXTZG + ICLEN=RALD%NDGLSUR+R%NNOEXTZG + IF( TALD%LFFT992 )THEN + CALL FFT992(PIA,TALD%TRIGSE,TALD%NFAXE,1,RALD%NDGLSUR+R%NNOEXTZG,IRLEN,KFC,ITYPE) +#ifdef WITH_FFTW + ELSEIF( TW%LFFTW )THEN + IOFF=1 + CALL EXEC_EFFTW(ITYPE,IRLEN,ICLEN,IOFF,KFC,TW%LALL_FFTW,PIA) +#endif + ELSE + CALL ABORT_TRANS('ELEINV_MOD:ELEINV: NO FFT PACKAGE SELECTED') + ENDIF +ENDIF + +IF (LHOOK) CALL DR_HOOK('ELEINV_MOD:ELEINV',1,ZHOOK_HANDLE) + +END SUBROUTINE ELEINV +END MODULE ELEINV_MOD diff --git a/src/etrans/etrans/internal/eleinvad_mod.F90 b/src/etrans/etrans/internal/eleinvad_mod.F90 new file mode 100644 index 000000000..15aa630cf --- /dev/null +++ b/src/etrans/etrans/internal/eleinvad_mod.F90 @@ -0,0 +1,115 @@ +MODULE ELEINVAD_MOD +CONTAINS +SUBROUTINE ELEINVAD(KM,KFC,KF_OUT_LT,PIA) + +!**** *ELEINVAD* - Inverse Legendre transform. + +! Purpose. +! -------- +! Inverse Legendre tranform of all variables(kernel). + +!** Interface. +! ---------- +! CALL ELEINVAD(...) + +! Explicit arguments : KM - zonal wavenumber (input-c) +! -------------------- KFC - number of fields to tranform (input-c) +! PIA - spectral fields +! for zonal wavenumber KM (input) +! PAOA1 - antisymmetric part of Fourier +! fields for zonal wavenumber KM (output) +! PSOA1 - symmetric part of Fourier +! fields for zonal wavenumber KM (output) +! PLEPO - Legendre polonomials for zonal +! wavenumber KM (input-c) + +! Implicit arguments : None. +! -------------------- + +! Method. +! ------- + +! Externals. MXMAOP - calls SGEMVX (matrix multiply) +! ---------- + +! Reference. +! ---------- +! ECMWF Research Department documentation of the IFS + +! Author. +! ------- +! Mats Hamrud and Philippe Courtier *ECMWF* + +! Modifications. +! -------------- +! Original : 00-02-01 From LEINVAD in IFS CY22R1 +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! D. Degrauwe (Feb 2012): Alternative extension zone (E') +! R. El Khatib 01-Sep-2015 support for FFTW transforms +! R. El Khatib 08-Jun-2023 LALL_FFTW for better flexibility +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_DIM ,ONLY : R +!USE TPM_GEOMETRY +!USE TPM_TRANS +USE TPMALD_FFT ,ONLY : TALD +#ifdef WITH_FFTW +USE TPM_FFTW ,ONLY : TW, EXEC_EFFTW +#endif +USE TPMALD_DIM ,ONLY : RALD +USE TPMALD_FFT ,ONLY : TALD +USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS +! + +IMPLICIT NONE + +INTEGER(KIND=JPIM), INTENT(IN) :: KM +INTEGER(KIND=JPIM), INTENT(IN) :: KFC +INTEGER(KIND=JPIM), INTENT(IN) :: KF_OUT_LT +REAL(KIND=JPRB), INTENT(OUT) :: PIA(:,:) + +INTEGER(KIND=JPIM) :: IRLEN, ICLEN, IOFF, ITYPE +INTEGER(KIND=JPIM) :: JJ, JF +REAL(KIND=JPRB) :: ZNORM +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +IF (LHOOK) CALL DR_HOOK('ELEINVAD_MOD:ELEINVAD',0,ZHOOK_HANDLE) + +IF (KFC>0) THEN + ITYPE=-1 + IRLEN=R%NDGL+R%NNOEXTZG + ICLEN=RALD%NDGLSUR+R%NNOEXTZG + IF( TALD%LFFT992 )THEN + CALL FFT992(PIA,TALD%TRIGSE,TALD%NFAXE,1,ICLEN,IRLEN,KFC,ITYPE) +#ifdef WITH_FFTW + ELSEIF( TW%LFFTW )THEN + IOFF=1 + CALL EXEC_EFFTW(ITYPE,IRLEN,ICLEN,IOFF,KFC,TW%LALL_FFTW,PIA) +#endif + ELSE + CALL ABORT_TRANS('ELEDIR_MOD:ELEINVAD: NO FFT PACKAGE SELECTED') + ENDIF + ZNORM=2.0_JPRB*REAL(R%NDGL+R%NNOEXTZG,JPRB) + DO JJ=1,1 + DO JF=1,KFC + PIA(JJ,JF) = (ZNORM/2.0_JPRB) * PIA(JJ,JF) + ENDDO + ENDDO + DO JJ=3,R%NDGL+R%NNOEXTZG+1 + DO JF=1,KFC + PIA(JJ,JF) = ZNORM * PIA(JJ,JF) + ENDDO + ENDDO +ENDIF + +IF (LHOOK) CALL DR_HOOK('ELEINVAD_MOD:ELEINVAD',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE ELEINVAD +END MODULE ELEINVAD_MOD diff --git a/src/etrans/etrans/internal/eltdir_ctl_mod.F90 b/src/etrans/etrans/internal/eltdir_ctl_mod.F90 new file mode 100644 index 000000000..5b38cb74e --- /dev/null +++ b/src/etrans/etrans/internal/eltdir_ctl_mod.F90 @@ -0,0 +1,117 @@ +MODULE ELTDIR_CTL_MOD +CONTAINS +SUBROUTINE ELTDIR_CTL(KF_FS,KF_UV,KF_SCALARS, & + & PSPVOR,PSPDIV,PSPSCALAR, & + & PSPSC3A,PSPSC3B,PSPSC2, & + & KFLDPTRUV,KFLDPTRSC,PSPMEANU,PSPMEANV,AUX_PROC) + +!**** *ELTDIR_CTL* - Control routine for direct Legendre transform + +! Purpose. +! -------- +! Direct Legendre transform + +!** Interface. +! ---------- +! CALL ELTDIR_CTL(...) + +! Explicit arguments : +! -------------------- +! KF_FS - number of fields in Fourier space +! KF_UV - local number of spectral u-v fields +! KF_SCALARS - local number of scalar spectral fields +! PSPVOR(:,:) - spectral vorticity (output) +! PSPDIV(:,:) - spectral divergence (output) +! PSPSCALAR(:,:) - spectral scalarvalued fields (output) +! KFLDPTRUV(:) - field pointer for vorticity and divergence (input) +! KFLDPTRSC(:) - field pointer for scalarvalued fields (input) +! PSPMEANU(:),PSPMEANV(:) - mean winds + +! R. El Khatib 02-Jun-2022 Optimization/Cleaning +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_GEN ,ONLY : LALLOPERM +USE TPM_TRANS ,ONLY : FOUBUF, FOUBUF_IN +USE TPM_DISTR ,ONLY : D + +USE ELTDIR_MOD ,ONLY : ELTDIR +USE EUVTVD_COMM_MOD , ONLY : EUVTVD_COMM +USE TRLTOM_MOD ,ONLY : TRLTOM +USE MPL_MODULE + +IMPLICIT NONE + +INTEGER(KIND=JPIM),INTENT(IN) :: KF_FS,KF_UV,KF_SCALARS +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPVOR(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPDIV(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPSCALAR(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPSC3A(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPSC3B(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPSC2(:,:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KFLDPTRUV(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KFLDPTRSC(:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPMEANU(:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPMEANV(:) +EXTERNAL AUX_PROC +OPTIONAL AUX_PROC + +INTEGER(KIND=JPIM) :: JM,IM,IBLEN,ILED2,INUL +REAL(KIND=JPRB) :: ZDUM +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE +! ------------------------------------------------------------------ + +! Transposition from Fourier space distribution to spectral space distribution + +IF (LHOOK) CALL DR_HOOK('ELTDIR_CTL_MOD:ELTDIR_CTL',0,ZHOOK_HANDLE) +IBLEN = D%NLENGT0B*2*KF_FS +IF (ALLOCATED(FOUBUF)) THEN + IF (MAX(1,IBLEN) > SIZE(FOUBUF)) THEN + DEALLOCATE(FOUBUF) + ALLOCATE(FOUBUF(MAX(1,IBLEN))) + ENDIF +ELSE + ALLOCATE(FOUBUF(MAX(1,IBLEN))) + FOUBUF(1)=0._JPRB ! enforce allocation here +ENDIF +CALL GSTATS(153,0) +CALL TRLTOM(FOUBUF_IN,FOUBUF,2*KF_FS) +CALL GSTATS(153,1) +IF (.NOT.LALLOPERM) DEALLOCATE(FOUBUF_IN) + +! Periodization of auxiliary fields in y direction + +IF (PRESENT(AUX_PROC)) THEN + CALL AUX_PROC(ZDUM,FOUBUF,2*KF_FS,1,IBLEN,0,D%NUMP,.FALSE.,& + & INUL,D%NPROCL,D%NSTAGT0B,D%NPNTGTB1) +ENDIF + +! Direct Legendre transform + +ILED2 = 2*KF_FS +CALL GSTATS(1645,0) +IF (KF_FS>0) THEN +!$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) PRIVATE(JM,IM) + DO JM=1,D%NUMP + IM = D%MYMS(JM) + CALL ELTDIR(IM,JM,KF_FS,KF_UV,KF_SCALARS,ILED2, & + & PSPVOR,PSPDIV,PSPSCALAR,& + & PSPSC3A,PSPSC3B,PSPSC2 , & + & KFLDPTRUV,KFLDPTRSC,PSPMEANU,PSPMEANV) + ENDDO +!$OMP END PARALLEL DO + IF (KF_UV > 0) THEN + CALL EUVTVD_COMM(KF_UV,PSPMEANU,PSPMEANV,KFLDPTRUV) + ENDIF +ENDIF +CALL GSTATS(1645,1) + +IF (.NOT.LALLOPERM) DEALLOCATE(FOUBUF) +IF (LHOOK) CALL DR_HOOK('ELTDIR_CTL_MOD:ELTDIR_CTL',1,ZHOOK_HANDLE) + +! ----------------------------------------------------------------- + +END SUBROUTINE ELTDIR_CTL +END MODULE ELTDIR_CTL_MOD diff --git a/src/etrans/etrans/internal/eltdir_ctlad_mod.F90 b/src/etrans/etrans/internal/eltdir_ctlad_mod.F90 new file mode 100644 index 000000000..3433e8ca4 --- /dev/null +++ b/src/etrans/etrans/internal/eltdir_ctlad_mod.F90 @@ -0,0 +1,109 @@ +MODULE ELTDIR_CTLAD_MOD +CONTAINS +SUBROUTINE ELTDIR_CTLAD(KF_FS,KF_UV,KF_SCALARS, & + & PSPVOR,PSPDIV,PSPSCALAR, & + & PSPSC3A,PSPSC3B,PSPSC2, & + & KFLDPTRUV,KFLDPTRSC,PSPMEANU,PSPMEANV) + +!**** *ELTDIR_CTLAD* - Control routine for direct Legendre transform + +! Purpose. +! -------- +! Direct Legendre transform + +!** Interface. +! ---------- +! CALL LTDIR_CTLAD(...) + +! Explicit arguments : +! -------------------- +! PSPVOR(:,:) - spectral vorticity (output) +! PSPDIV(:,:) - spectral divergence (output) +! PSPSCALAR(:,:) - spectral scalarvalued fields (output) + +! R. El Khatib 02-Jun-2022 Optimization/Cleaning +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_GEN ,ONLY : LALLOPERM +!USE TPM_DIM +USE TPM_TRANS ,ONLY : FOUBUF, FOUBUF_IN +USE TPM_DISTR ,ONLY : D + +USE ELTDIRAD_MOD ,ONLY : ELTDIRAD +USE TRMTOL_MOD ,ONLY : TRMTOL + + +IMPLICIT NONE + +INTEGER(KIND=JPIM),INTENT(IN) :: KF_FS,KF_UV,KF_SCALARS +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPVOR(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPDIV(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPSCALAR(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPSC3A(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPSC3B(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPSC2(:,:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KFLDPTRUV(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KFLDPTRSC(:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPMEANU(:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPMEANV(:) + +INTEGER(KIND=JPIM) :: JM,IM,IBLEN,ILED2 +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +! Transposition from Fourier space distribution to spectral space distribution + +IF (LHOOK) CALL DR_HOOK('ELTDIR_CTLAD_MOD:ELTDIR_CTLAD',0,ZHOOK_HANDLE) +IBLEN = D%NLENGT0B*2*KF_FS +IF (ALLOCATED(FOUBUF_IN)) THEN + IF (MAX(1,IBLEN) > SIZE(FOUBUF_IN)) THEN + DEALLOCATE(FOUBUF_IN) + ALLOCATE(FOUBUF_IN(MAX(1,IBLEN))) + FOUBUF_IN(1)=0._JPRB ! force allocation here + ENDIF +ELSE + ALLOCATE(FOUBUF_IN(MAX(1,IBLEN))) + FOUBUF_IN(1)=0._JPRB ! force allocation here +ENDIF +IF (ALLOCATED(FOUBUF)) THEN + IF (MAX(1,IBLEN) > SIZE(FOUBUF)) THEN + DEALLOCATE(FOUBUF) + ALLOCATE(FOUBUF(MAX(1,IBLEN))) + FOUBUF(1)=0._JPRB ! force allocation here + ENDIF +ELSE + ALLOCATE(FOUBUF(MAX(1,IBLEN))) + FOUBUF(1)=0._JPRB ! force allocation here +ENDIF + +! Direct Legendre transform + +ILED2 = 2*KF_FS +CALL GSTATS(1646,0) +IF(KF_FS > 0) THEN +!$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) PRIVATE(JM,IM) + DO JM=1,D%NUMP + IM = D%MYMS(JM) + CALL ELTDIRAD(IM,JM,KF_FS,KF_UV,KF_SCALARS,ILED2, & + & PSPVOR,PSPDIV,PSPSCALAR,& + & PSPSC3A,PSPSC3B,PSPSC2 , & + & KFLDPTRUV,KFLDPTRSC, PSPMEANU,PSPMEANV) + ENDDO +!$OMP END PARALLEL DO +ENDIF +CALL GSTATS(1646,1) + +CALL GSTATS(181,0) +CALL TRMTOL(FOUBUF,FOUBUF_IN,2*KF_FS) +CALL GSTATS(181,1) +IF (.NOT.LALLOPERM) DEALLOCATE(FOUBUF) +IF (LHOOK) CALL DR_HOOK('ELTDIR_CTLAD_MOD:ELTDIR_CTLAD',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE ELTDIR_CTLAD +END MODULE ELTDIR_CTLAD_MOD diff --git a/src/etrans/etrans/internal/eltdir_mod.F90 b/src/etrans/etrans/internal/eltdir_mod.F90 new file mode 100644 index 000000000..01a9a1ec8 --- /dev/null +++ b/src/etrans/etrans/internal/eltdir_mod.F90 @@ -0,0 +1,184 @@ +MODULE ELTDIR_MOD +CONTAINS +SUBROUTINE ELTDIR(KM,KMLOC,KF_FS,KF_UV,KF_SCALARS,KLED2,& + & PSPVOR,PSPDIV,PSPSCALAR,PSPSC3A,PSPSC3B,PSPSC2,& + & KFLDPTRUV,KFLDPTRSC,PSPMEANU,PSPMEANV) + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_DIM ,ONLY : R +USE TPM_DISTR ,ONLY : D +USE TPMALD_DIM ,ONLY : RALD + +USE EPRFI2_MOD ,ONLY : EPRFI2 +USE ELEDIR_MOD ,ONLY : ELEDIR +USE EUVTVD_MOD +USE EUPDSP_MOD ,ONLY : EUPDSP +USE EXTPER_MOD ,ONLY : EXTPER + +! +!**** *ELTDIR* - Control of Direct Legendre transform step + +! Purpose. +! -------- +! Tranform from Fourier space to spectral space, compute +! vorticity and divergence. + +!** Interface. +! ---------- +! *CALL* *ELTDIR(...)* + +! Explicit arguments : +! -------------------- KM - zonal wavenumber +! KMLOC - local zonal wavenumber + +! Implicit arguments : None +! -------------------- + +! Method. +! ------- + +! Externals. +! ---------- +! EPRFI2 - prepares the Fourier work arrays for model variables +! ELEDIR - direct Legendre transform +! EUVTVD - +! EUPDSP - updating of spectral arrays (fields) +! EUVTVD_COMM - +! EXTPER - + + +! Reference. +! ---------- +! ECMWF Research Department documentation of the IFS + +! Author. +! ------- +! Mats Hamrud and Philippe Courtier *ECMWF* + +! Modifications. +! -------------- +! Original : 87-11-24 +! Modified : 91-07-01 Philippe Courtier/Mats Hamrud - Rewrite +! for uv formulation +! Modified 93-03-19 D. Giard - CDCONF='T' for tendencies +! Modified 93-11-18 M. Hamrud - use only one Fourier buffer +! Modified 94-04-06 R. El khatib Full-POS implementation +! M.Hamrud : 94-11-01 New conf 'G' - vor,div->vor,div +! instead of u,v->vor,div +! MPP Group : 95-10-01 Support for Distributed Memory version +! K. YESSAD (AUGUST 1996): +! - Legendre transforms for transmission coefficients. +! Modified : 04/06/99 D.Salmond : change order of AIA and SIA +! 01-03-14 G. Radnoti aladin version +! 01-08-27 : R. El Khatib Fix for NPROMATR /= 0 +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! F. Vana + NEC 28-Apr-2009 MPI-OpenMP fix +! D. Degrauwe (Feb 2012): Alternative extension zone (E') +! N. Lopes & R. El Khatib 15-Jun-2012 Scalability enhancement +! R. El Khatib 02-Jun-2022 Optimization/Cleaning +! ------------------------------------------------------------------ + +IMPLICIT NONE + +INTEGER(KIND=JPIM),INTENT(IN) :: KM +INTEGER(KIND=JPIM),INTENT(IN) :: KMLOC +INTEGER(KIND=JPIM),INTENT(IN) :: KF_FS,KF_UV,KF_SCALARS,KLED2 + +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPVOR(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPDIV(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPSCALAR(:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PSPSC2(:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PSPSC3A(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PSPSC3B(:,:,:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KFLDPTRUV(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KFLDPTRSC(:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPMEANU(:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPMEANV(:) + +INTEGER(KIND=JPIM) :: IFC, IINDEX(2*KF_FS), JF, JDIM +INTEGER(KIND=JPIM) :: IFLD, IR, J +INTEGER(KIND=JPIM) :: IUS,IVS,IVORS,IDIVS + +REAL(KIND=JPRB) :: ZFFT(RALD%NDGLSUR+R%NNOEXTZG,KLED2,D%NUMP) +REAL(KIND=JPRB) :: ZVODI(RALD%NDGLSUR+R%NNOEXTZG,MAX(4*KF_UV,1),D%NUMP) + +! Only if R%NNOEXTZG > 0 : +REAL(KIND=JPRB) :: ZFFT2(KLED2,(RALD%NDGLSUR+R%NNOEXTZG)*MIN(1,R%NNOEXTZG)) + +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +IF (LHOOK) CALL DR_HOOK('ELTDIR_MOD:ELTDIR',0,ZHOOK_HANDLE) + +IUS = 1 +IVS = 2*KF_UV+1 +IVORS = IUS +IDIVS = IVS +IFC = 2*KF_FS + +!* 1. PREPARE WORK ARRAYS. +! -------------------- + +CALL EPRFI2(KM,KMLOC,KF_FS,ZFFT(:,:,KMLOC)) + +!* 2. PERIODICIZATION IN Y DIRECTION +! ------------------------------ + +IF(R%NNOEXTZG>0) THEN + DO JF = 1,IFC + DO JDIM = 1,R%NDGL + ZFFT2(JF,JDIM)=ZFFT(JDIM,JF,KMLOC) + ENDDO + ENDDO + IINDEX(1)=0 + CALL EXTPER(ZFFT2(:,:),R%NDGL+R%NNOEXTZG,1,R%NDGL,IFC,1,IINDEX,0) + DO JF = 1,IFC + DO JDIM = 1,R%NDGL+R%NNOEXTZG + ZFFT(JDIM,JF,KMLOC) = ZFFT2(JF,JDIM) + ENDDO + ENDDO +ENDIF + +!* 3. DIRECT LEGENDRE TRANSFORM. +! -------------------------- + +CALL ELEDIR(KM,IFC,KLED2,ZFFT(:,:,KMLOC)) + +!* 4. COMPUTE VORTICITY AND DIVERGENCE AND STORE MEAN WIND ON TASK OWNING WAVE 0 +! -------------------------------------------------------------------------- + +IF( KF_UV > 0 ) THEN + CALL EUVTVD(KM,KMLOC,KF_UV,ZFFT(:,IUS:,KMLOC),ZFFT(:,IVS:,KMLOC),& + & ZVODI(:,IVORS:,KMLOC),ZVODI(:,IDIVS:,KMLOC)) + IF (KM == 0) THEN + IF (PRESENT(KFLDPTRUV)) THEN + DO J = 1, KF_UV + IR = 2*J-1 + IFLD=KFLDPTRUV(J) + PSPMEANU(IFLD)=ZFFT(1,IUS-1+IR,KMLOC) + PSPMEANV(IFLD)=ZFFT(1,IVS-1+IR,KMLOC) + ENDDO + ELSE + DO J = 1, KF_UV + IR = 2*J-1 + PSPMEANU(J)=ZFFT(1,IUS-1+IR,KMLOC) + PSPMEANV(J)=ZFFT(1,IVS-1+IR,KMLOC) + ENDDO + ENDIF + ENDIF +ENDIF + +!* 5. UPDATE SPECTRAL ARRAYS. +! ----------------------- + +CALL EUPDSP(KM,KF_UV,KF_SCALARS,ZFFT(:,:,KMLOC),ZVODI(:,:,KMLOC), & + & PSPVOR,PSPDIV,PSPSCALAR,PSPSC3A,PSPSC3B,PSPSC2,KFLDPTRUV,KFLDPTRSC) + +IF (LHOOK) CALL DR_HOOK('ELTDIR_MOD:ELTDIR',1,ZHOOK_HANDLE) +! ------------------------------------------------------------------ + +END SUBROUTINE ELTDIR +END MODULE ELTDIR_MOD diff --git a/src/etrans/etrans/internal/eltdirad_mod.F90 b/src/etrans/etrans/internal/eltdirad_mod.F90 new file mode 100644 index 000000000..fd11df013 --- /dev/null +++ b/src/etrans/etrans/internal/eltdirad_mod.F90 @@ -0,0 +1,166 @@ +MODULE ELTDIRAD_MOD +CONTAINS +SUBROUTINE ELTDIRAD(KM,KMLOC,KF_FS,KF_UV,KF_SCALARS,KLED2,& + & PSPVOR,PSPDIV,PSPSCALAR,& + & PSPSC3A,PSPSC3B,PSPSC2 , & + & KFLDPTRUV,KFLDPTRSC,PSPMEANU,PSPMEANV) + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_DIM ,ONLY : R +USE TPMALD_DIM ,ONLY : RALD + +USE EPRFI2AD_MOD ,ONLY : EPRFI2AD +USE ELEDIRAD_MOD ,ONLY : ELEDIRAD +USE EUVTVDAD_MOD +USE EUPDSPAD_MOD ,ONLY : EUPDSPAD + + +!**** *ELTDIRAD* - Control of Direct Legendre transform step - adjoint + +! Purpose. +! -------- +! Tranform from Fourier space to spectral space, compute +! vorticity and divergence. + +!** Interface. +! ---------- +! *CALL* *ELTDIRAD(...)* + +! Explicit arguments : +! -------------------- KM - zonal wavenumber +! KMLOC - local zonal wavenumber +! PSPVOR - spectral vorticity +! PSPDIV - spectral divergence +! PSPSCALAR - spectral scalar variables + +! Implicit arguments : None +! -------------------- + +! Method. +! ------- + +! Externals. +! ---------- +! EPRFI2AD - prepares the Fourier work arrays for model variables. +! ELEDIRAD - direct Legendre transform +! EUVTVDAD - +! EUPDSPAD - updating of spectral arrays (fields) + +! Reference. +! ---------- +! ECMWF Research Department documentation of the IFS + +! Author. +! ------- +! Mats Hamrud and Philippe Courtier *ECMWF* + +! Modifications. +! -------------- +! Original : 87-11-24 +! Modified : 91-07-01 Philippe Courtier/Mats Hamrud - Rewrite +! for uv formulation +! Modified 93-03-19 D. Giard - CDCONF='T' for tendencies +! Modified 93-11-18 M. Hamrud - use only one Fourier buffer +! Modified 94-04-06 R. El khatib Full-POS implementation +! M.Hamrud : 94-11-01 New conf 'G' - vor,div->vor,div +! instead of u,v->vor,div +! MPP Group : 95-10-01 Support for Distributed Memory version +! K. YESSAD (AUGUST 1996): +! - Legendre transforms for transmission coefficients. +! Modified : 04/06/99 D.Salmond : change order of AIA and SIA +! 01-08-27 : R. El Khatib Fix for NPROMATR /= 0 +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! D. Degrauwe (Feb 2012): Alternative extension zone (E') +! N. Lopes & R. El Khatib 15-Jun-2012 Scalability enhancement + +! thread-safety +! ------------------------------------------------------------------ +! +IMPLICIT NONE +! +INTEGER(KIND=JPIM), INTENT(IN) :: KM +INTEGER(KIND=JPIM), INTENT(IN) :: KMLOC +INTEGER(KIND=JPIM),INTENT(IN) :: KF_FS,KF_UV,KF_SCALARS,KLED2 + +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPVOR(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPDIV(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPSCALAR(:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(INOUT) :: PSPSC2(:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(INOUT) :: PSPSC3A(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(INOUT) :: PSPSC3B(:,:,:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KFLDPTRUV(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KFLDPTRSC(:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPMEANU(:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPMEANV(:) + +INTEGER(KIND=JPIM) :: IFC +INTEGER(KIND=JPIM) :: IUS,IUE,IVS,IVE,IVORS,IVORE,IDIVS,IDIVE + +REAL(KIND=JPRB) :: ZFFT(RALD%NDGLSUR+R%NNOEXTZG,KLED2) +REAL(KIND=JPRB) :: ZVODI(RALD%NDGLSUR+R%NNOEXTZG,MAX(4*KF_UV,1)) +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +!* 1. PREPARE LEGENDRE POLONOMIALS AND EPSNM +! -------------------------------------- + +IF (LHOOK) CALL DR_HOOK('ELTDIRAD_MOD:ELTDIRAD',0,ZHOOK_HANDLE) +ZFFT=0.0_JPRB +ZVODI=0.0_JPRB + +! ------------------------------------------------------------------ + +!* 6. UPDATE SPECTRAL ARRAYS. +! ----------------------- + +CALL EUPDSPAD(KM,KF_UV,KF_SCALARS,ZFFT,ZVODI, & + & PSPVOR,PSPDIV,PSPSCALAR,& + & PSPSC3A,PSPSC3B,PSPSC2 , & + & KFLDPTRUV,KFLDPTRSC) + +! ------------------------------------------------------------------ + +!* 5. COMPUTE VORTICITY AND DIVERGENCE. +! --------------------------------- +IF( KF_UV > 0 ) THEN + IUS = 1 + IUE = 2*KF_UV + IVS = 2*KF_UV+1 + IVE = 4*KF_UV + IVORS = 1 + IVORE = 2*KF_UV + IDIVS = 2*KF_UV+1 + IDIVE = 4*KF_UV +! SET PART OF ZFFT CONTAINING U AND V TO 0. + ZFFT(:,IUS:IVE) = 0.0_JPRB + CALL EUVTVDAD(KM,KMLOC,KF_UV,KFLDPTRUV,ZFFT(:,IUS:IUE),ZFFT(:,IVS:IVE),& + & ZVODI(:,IVORS:IVORE),ZVODI(:,IDIVS:IDIVE),PSPMEANU,PSPMEANV) +ENDIF + +! ------------------------------------------------------------------ + +!* 4. DIRECT LEGENDRE TRANSFORM. +! -------------------------- +IFC = 2*KF_FS +CALL ELEDIRAD(KM,IFC,KLED2,ZFFT) + +! ------------------------------------------------------------------ + +!* 3. FOURIER SPACE COMPUTATIONS. +! --------------------------- + +! ------------------------------------------------------------------ + +!* 2. PREPARE WORK ARRAYS. +! -------------------- + +CALL EPRFI2AD(KM,KMLOC,KF_FS,ZFFT) +IF (LHOOK) CALL DR_HOOK('ELTDIRAD_MOD:ELTDIRAD',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE ELTDIRAD +END MODULE ELTDIRAD_MOD + diff --git a/src/etrans/etrans/internal/eltinv_ctl_mod.F90 b/src/etrans/etrans/internal/eltinv_ctl_mod.F90 new file mode 100644 index 000000000..dea5b7b6e --- /dev/null +++ b/src/etrans/etrans/internal/eltinv_ctl_mod.F90 @@ -0,0 +1,129 @@ +MODULE ELTINV_CTL_MOD +CONTAINS +SUBROUTINE ELTINV_CTL(KF_OUT_LT,KF_UV,KF_SCALARS,KF_SCDERS,& + & PSPVOR,PSPDIV,PSPSCALAR,& + & PSPSC3A,PSPSC3B,PSPSC2,& + & KFLDPTRUV,KFLDPTRSC,PSPMEANU,PSPMEANV,FSPGL_PROC) + +!**** *ELTINV_CTL* - Control routine for inverse Legandre transform. + +! Purpose. +! -------- +! Control routine for the inverse LEGENDRE transform + +!** Interface. +! ---------- +! CALL EINV_TRANS_CTL(...) +! KF_OUT_LT - number of fields coming out from inverse LT +! KF_UV - local number of spectral u-v fields +! KF_SCALARS - local number of scalar spectral fields +! KF_SCDERS - local number of derivatives of scalar spectral fields +! PSPVOR(:,:) - spectral vorticity (input) +! PSPDIV(:,:) - spectral divergence (input) +! PSPSCALAR(:,:) - spectral scalarvalued fields (input) +! KFLDPTRUV(:) - field pointer array for vor./div. +! KFLDPTRSC(:) - field pointer array for PSPSCALAR +! FSPGL_PROC - external procedure to be executed in fourier space +! before transposition + +! Method. +! ------- + +! Externals. +! ---------- + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-06-03 +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! O.Spaniel Oct-2004 phasing for AL29 +! R. El Khatib 02-Jun-2022 Optimization/Cleaning +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_GEN ,ONLY : LALLOPERM +!USE TPM_DIM +USE TPM_TRANS ,ONLY : FOUBUF, FOUBUF_IN +USE TPM_DISTR ,ONLY : D + +USE ELTINV_MOD ,ONLY : ELTINV +USE TRMTOL_MOD ,ONLY : TRMTOL +! + +IMPLICIT NONE + +INTEGER(KIND=JPIM),INTENT(IN) :: KF_OUT_LT,KF_UV,KF_SCALARS,KF_SCDERS +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPVOR(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPDIV(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPSCALAR(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPSC3A(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPSC3B(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPSC2(:,:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KFLDPTRUV(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KFLDPTRSC(:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPMEANU(:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPMEANV(:) + +EXTERNAL FSPGL_PROC +OPTIONAL FSPGL_PROC + +INTEGER(KIND=JPIM) :: JM,IM,IBLEN,ILEI2,IDIM1 +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +IF (LHOOK) CALL DR_HOOK('ELTINV_CTL_MOD:ELTINV_CTL',0,ZHOOK_HANDLE) +ILEI2 = 8*KF_UV + 2*KF_SCALARS + 2*KF_SCDERS +IDIM1 = 2*KF_OUT_LT +IBLEN = D%NLENGT0B*2*KF_OUT_LT +IF (ALLOCATED(FOUBUF)) THEN + IF (MAX(1,IBLEN) > SIZE(FOUBUF)) THEN + DEALLOCATE(FOUBUF) + ALLOCATE(FOUBUF(MAX(1,IBLEN))) + FOUBUF(1)=0._JPRB ! to force allocation here + ENDIF +ELSE + ALLOCATE(FOUBUF(MAX(1,IBLEN))) + FOUBUF(1)=0._JPRB ! to force allocation here +ENDIF +IF (ALLOCATED(FOUBUF_IN)) THEN + IF (MAX(1,IBLEN) > SIZE(FOUBUF_IN)) THEN + DEALLOCATE(FOUBUF_IN) + ALLOCATE(FOUBUF_IN(MAX(1,IBLEN))) + FOUBUF_IN(1)=0._JPRB ! to force allocation here + ENDIF +ELSE + ALLOCATE(FOUBUF_IN(MAX(1,IBLEN))) + FOUBUF_IN(1)=0._JPRB ! to force allocation here +ENDIF + +IF(KF_OUT_LT > 0) THEN +CALL GSTATS(1647,0) +!$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) PRIVATE(JM,IM) + DO JM=1,D%NUMP + IM = D%MYMS(JM) + CALL ELTINV(IM,JM,KF_OUT_LT,KF_UV,KF_SCALARS,KF_SCDERS,ILEI2,IDIM1,& + & PSPVOR,PSPDIV,PSPSCALAR ,& + & PSPSC3A,PSPSC3B,PSPSC2 , & + & KFLDPTRUV,KFLDPTRSC,FSPGL_PROC,PSPMEANU,PSPMEANV) + ENDDO +!$OMP END PARALLEL DO +CALL GSTATS(1647,1) +ENDIF + +CALL GSTATS(152,0) +CALL TRMTOL(FOUBUF_IN,FOUBUF,2*KF_OUT_LT) +CALL GSTATS(152,1) +IF (.NOT.LALLOPERM) DEALLOCATE(FOUBUF_IN) +IF (LHOOK) CALL DR_HOOK('ELTINV_CTL_MOD:ELTINV_CTL',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE ELTINV_CTL +END MODULE ELTINV_CTL_MOD diff --git a/src/etrans/etrans/internal/eltinv_ctlad_mod.F90 b/src/etrans/etrans/internal/eltinv_ctlad_mod.F90 new file mode 100644 index 000000000..43e8f4c4c --- /dev/null +++ b/src/etrans/etrans/internal/eltinv_ctlad_mod.F90 @@ -0,0 +1,116 @@ +MODULE ELTINV_CTLAD_MOD +CONTAINS +SUBROUTINE ELTINV_CTLAD(KF_OUT_LT,KF_UV,KF_SCALARS,KF_SCDERS,& + & PSPVOR,PSPDIV,PSPSCALAR,& + & PSPSC3A,PSPSC3B,PSPSC2,& + & KFLDPTRUV,KFLDPTRSC,FSPGL_PROC,PSPMEANU,PSPMEANV) + +!**** *ELTINV_CTLAD* - Control routine for inverse Legandre transform - adj. + +! Purpose. +! -------- +! Control routine for the inverse LEGENDRE transform + +!** Interface. +! ---------- +! CALL EINV_TRANS_CTL(...) +! KF_OUT_LT - number of fields coming out from inverse LT +! KF_UV - local number of spectral u-v fields +! KF_SCALARS - local number of scalar spectral fields +! KF_SCDERS - local number of derivatives of scalar spectral fields +! PSPVOR(:,:) - spectral vorticity (input) +! PSPDIV(:,:) - spectral divergence (input) +! PSPSCALAR(:,:) - spectral scalarvalued fields (input) +! KFLDPTRUV(:) - field pointer array for vor./div. +! KFLDPTRSC(:) - field pointer array for PSPSCALAR +! FSPGL_PROC - external procedure to be executed in fourier space +! before transposition + +! Method. +! ------- + +! Externals. +! ---------- + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-06-03 +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! O.Spaniel Oct-2004 phasing for AL29 +! N. Lopes & R. El Khatib 15-Jun-2012 Scalability enhancement + +! thread-safety +! R. El Khatib 02-Jun-2022 Optimization/Cleaning +! ------------------------------------------------------------------ +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK +USE TPM_GEN ,ONLY : LALLOPERM +!USE TPM_DIM +USE TPM_TRANS ,ONLY : FOUBUF, FOUBUF_IN +USE TPM_DISTR ,ONLY : D +USE ELTINVAD_MOD ,ONLY : ELTINVAD +USE TRLTOM_MOD ,ONLY : TRLTOM +! + +IMPLICIT NONE + +INTEGER(KIND=JPIM),INTENT(IN) :: KF_OUT_LT +INTEGER(KIND=JPIM),INTENT(IN) :: KF_UV +INTEGER(KIND=JPIM),INTENT(IN) :: KF_SCALARS +INTEGER(KIND=JPIM),INTENT(IN) :: KF_SCDERS +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPVOR(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPDIV(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPSCALAR(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPSC3A(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPSC3B(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPSC2(:,:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KFLDPTRUV(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KFLDPTRSC(:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPMEANU(:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPMEANV(:) + +EXTERNAL FSPGL_PROC +OPTIONAL FSPGL_PROC + +INTEGER(KIND=JPIM) :: IBLEN, ILEI2 +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +IF (LHOOK) CALL DR_HOOK('ELTINV_CTLAD_MOD:ELTINV_CTLAD',0,ZHOOK_HANDLE) + +ILEI2 = 8*KF_UV + 2*KF_SCALARS + 2*KF_SCDERS +IBLEN = D%NLENGT0B*2*KF_OUT_LT +IF (ALLOCATED(FOUBUF_IN)) THEN + IF (MAX(1,IBLEN) > SIZE(FOUBUF_IN)) THEN + DEALLOCATE(FOUBUF_IN) + ALLOCATE(FOUBUF_IN(MAX(1,IBLEN))) + FOUBUF_IN(1)=0._JPRB ! force allocation here + ENDIF +ELSE + ALLOCATE(FOUBUF_IN(MAX(1,IBLEN))) + FOUBUF_IN(1)=0._JPRB ! force allocation here +ENDIF +CALL GSTATS(180,0) +CALL TRLTOM(FOUBUF,FOUBUF_IN,2*KF_OUT_LT) +CALL GSTATS(180,1) +IF (.NOT.LALLOPERM) DEALLOCATE(FOUBUF) + +CALL GSTATS(1648,0) +IF(KF_OUT_LT > 0) THEN + CALL ELTINVAD(KF_OUT_LT,KF_UV,KF_SCALARS,KF_SCDERS,ILEI2,& + & PSPVOR,PSPDIV,PSPSCALAR,PSPSC3A,PSPSC3B,PSPSC2, & + & KFLDPTRUV,KFLDPTRSC,FSPGL_PROC,PSPMEANU,PSPMEANV) +ENDIF +CALL GSTATS(1648,1) + +IF (.NOT.LALLOPERM) DEALLOCATE(FOUBUF_IN) +IF (LHOOK) CALL DR_HOOK('ELTINV_CTLAD_MOD:ELTINV_CTLAD',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE ELTINV_CTLAD +END MODULE ELTINV_CTLAD_MOD diff --git a/src/etrans/etrans/internal/eltinv_mod.F90 b/src/etrans/etrans/internal/eltinv_mod.F90 new file mode 100644 index 000000000..524ace889 --- /dev/null +++ b/src/etrans/etrans/internal/eltinv_mod.F90 @@ -0,0 +1,213 @@ +MODULE ELTINV_MOD +CONTAINS +SUBROUTINE ELTINV(KM,KMLOC,KF_OUT_LT,KF_UV,KF_SCALARS,KF_SCDERS,KLEI2,KDIM1,& + & PSPVOR,PSPDIV,PSPSCALAR,& + & PSPSC3A,PSPSC3B,PSPSC2 , & + & KFLDPTRUV,KFLDPTRSC,FSPGL_PROC,PSPMEANU,PSPMEANV) + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_DIM ,ONLY : R +USE TPM_TRANS ,ONLY : LDIVGP, LVORGP, NF_SC2, NF_SC3A, NF_SC3B +USE TPMALD_DIM ,ONLY : RALD +USE EPRFI1B_MOD ,ONLY : EPRFI1B +USE EVDTUV_MOD ,ONLY : EVDTUV +USE ESPNSDE_MOD ,ONLY : ESPNSDE +USE ELEINV_MOD ,ONLY : ELEINV +USE EASRE1B_MOD ,ONLY : EASRE1B +USE FSPGL_INT_MOD ,ONLY : FSPGL_INT +USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS + +!**** *LTINV* - Inverse Legendre transform + +! Purpose. +! -------- +! Tranform from Laplace space to Fourier space, compute U and V +! and north/south derivatives of state variables. + +!** Interface. +! ---------- +! *CALL* *LTINV(...) + +! Explicit arguments : +! -------------------- +! KM - zonal wavenumber +! KMLOC - local zonal wavenumber +! PSPVOR - spectral vorticity +! PSPDIV - spectral divergence +! PSPSCALAR - spectral scalar variables + +! Implicit arguments : The Laplace arrays of the model. +! -------------------- The values of the Legendre polynomials +! The grid point arrays of the model +! Method. +! ------- + +! Externals. +! ---------- + +! PREPSNM - prepare REPSNM for wavenumber KM +! PRFI1B - prepares the spectral fields +! VDTUV - compute u and v from vorticity and divergence +! SPNSDE - compute north-south derivatives +! LEINV - Inverse Legendre transform +! ASRE1 - recombination of symmetric/antisymmetric part + +! Reference. +! ---------- +! ECMWF Research Department documentation of the IFS +! Temperton, 1991, MWR 119 p1303 + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-02-01 From LTINV in IFS CY22R1 +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! D. Degrauwe (Feb 2012): Alternative extension zone (E') +! R. El Khatib 26-Aug-2021 Optimization for EASRE1B +! ------------------------------------------------------------------ + +IMPLICIT NONE + +INTEGER(KIND=JPIM), INTENT(IN) :: KM +INTEGER(KIND=JPIM), INTENT(IN) :: KMLOC +INTEGER(KIND=JPIM), INTENT(IN) :: KF_OUT_LT +INTEGER(KIND=JPIM), INTENT(IN) :: KF_UV +INTEGER(KIND=JPIM), INTENT(IN) :: KF_SCALARS +INTEGER(KIND=JPIM), INTENT(IN) :: KF_SCDERS +INTEGER(KIND=JPIM), INTENT(IN) :: KLEI2 +INTEGER(KIND=JPIM), INTENT(IN) :: KDIM1 + +REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PSPVOR(:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PSPDIV(:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PSPSCALAR(:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PSPSC2(:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PSPSC3A(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PSPSC3B(:,:,:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KFLDPTRUV(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KFLDPTRSC(:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPMEANU(:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPMEANV(:) +EXTERNAL FSPGL_PROC +OPTIONAL FSPGL_PROC + +REAL(KIND=JPRB) :: ZIA(RALD%NDGLSUR+R%NNOEXTZG,KLEI2) + +INTEGER(KIND=JPIM) :: IFC, ISTA +INTEGER(KIND=JPIM) :: IVORL,IVORU,IDIVL,IDIVU,IUL,IUU,IVL,IVU,ISL,ISU,IDL,IDU +INTEGER(KIND=JPIM) :: IFIRST, ILAST,IDIM1,IDIM3,J3 +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + + + +! ------------------------------------------------------------------ + +!* 3. SPECTRAL COMPUTATIONS FOR U,V AND DERIVATIVES. +! ---------------------------------------------- + +IF (LHOOK) CALL DR_HOOK('ELTINV_MOD:ELTINV',0,ZHOOK_HANDLE) +IFIRST = 1 +ILAST = 4*KF_UV +ZIA=0.0_JPRB +IF (KF_UV > 0) THEN + IVORL = 1 + IVORU = 2*KF_UV + IDIVL = 2*KF_UV+1 + IDIVU = 4*KF_UV + IUL = 4*KF_UV+1 + IUU = 6*KF_UV + IVL = 6*KF_UV+1 + IVU = 8*KF_UV + CALL EPRFI1B(KM,ZIA(:,IVORL:IVORU),PSPVOR,KF_UV,KFLDPTRUV) + CALL EPRFI1B(KM,ZIA(:,IDIVL:IDIVU),PSPDIV,KF_UV,KFLDPTRUV) + ILAST = ILAST+4*KF_UV + CALL EVDTUV(KM,KF_UV,KFLDPTRUV,ZIA(:,IVORL:IVORU),ZIA(:,IDIVL:IDIVU),& + & ZIA(:,IUL:IUU),ZIA(:,IVL:IVU),PSPMEANU,PSPMEANV) + +ENDIF + +IF(KF_SCALARS > 0)THEN + IF(PRESENT(PSPSCALAR)) THEN + IFIRST = ILAST+1 + ILAST = IFIRST - 1 + 2*KF_SCALARS + CALL EPRFI1B(KM,ZIA(:,IFIRST:ILAST),PSPSCALAR(:,:),KF_SCALARS,KFLDPTRSC) + ELSE + IF(PRESENT(PSPSC2) .AND. NF_SC2 > 0) THEN + IFIRST = ILAST+1 + ILAST = IFIRST-1+2*NF_SC2 + CALL EPRFI1B(KM,ZIA(:,IFIRST:ILAST),PSPSC2(:,:),NF_SC2) + ENDIF + IF(PRESENT(PSPSC3A) .AND. NF_SC3A > 0) THEN + IDIM1=NF_SC3A + IDIM3=UBOUND(PSPSC3A,3) + DO J3=1,IDIM3 + IFIRST = ILAST+1 + ILAST = IFIRST-1+2*IDIM1 + CALL EPRFI1B(KM,ZIA(:,IFIRST:ILAST),PSPSC3A(:,:,J3),IDIM1) + ENDDO + ENDIF + IF(PRESENT(PSPSC3B) .AND. NF_SC3B > 0) THEN + IDIM1=NF_SC3B + IDIM3=UBOUND(PSPSC3B,3) + DO J3=1,IDIM3 + IFIRST = ILAST+1 + ILAST = IFIRST-1+2*IDIM1 + CALL EPRFI1B(KM,ZIA(:,IFIRST:ILAST),PSPSC3B(:,:,J3),IDIM1) + ENDDO + ENDIF + ENDIF + IF(ILAST /= 8*KF_UV+2*KF_SCALARS) THEN + WRITE(0,*) 'LTINV:KF_UV,KF_SCALARS,ILAST ',KF_UV,KF_SCALARS,ILAST + CALL ABORT_TRANS('LTINV_MOD:ILAST /= 8*KF_UV+2*KF_SCALARS') + ENDIF +ENDIF + +IF (KF_SCDERS > 0) THEN + ISL = 2*(4*KF_UV)+1 + ISU = ISL+2*KF_SCALARS-1 + IDL = 2*(4*KF_UV+KF_SCALARS)+1 + IDU = IDL+2*KF_SCDERS-1 + CALL ESPNSDE(KM,KF_SCALARS,ZIA(:,ISL:ISU),ZIA(:,IDL:IDU)) +ENDIF + +! ------------------------------------------------------------------ + +!* 4. INVERSE LEGENDRE TRANSFORM. +! --------------------------- + +ISTA = 1 +IFC = 2*KF_OUT_LT +IF(KF_UV > 0 .AND. .NOT. LVORGP) THEN + ISTA = ISTA+2*KF_UV +ENDIF +IF(KF_UV > 0 .AND. .NOT. LDIVGP) THEN + ISTA = ISTA+2*KF_UV +ENDIF + +CALL ELEINV(KM,IFC,KF_OUT_LT,ZIA(:,ISTA:ISTA+IFC-1)) + +! ------------------------------------------------------------------ + +!* 5. RECOMBINATION SYMMETRIC/ANTISYMMETRIC PART. +! -------------------------------------------- + +CALL EASRE1B(IFC,KM,KMLOC,ZIA(:,ISTA:ISTA+IFC-1)) +! ------------------------------------------------------------------ + +! 6. OPTIONAL COMPUTATIONS IN FOURIER SPACE + +IF(PRESENT(FSPGL_PROC)) THEN + CALL FSPGL_INT(KM,KMLOC,KF_UV,KF_SCALARS,KF_SCDERS,KF_OUT_LT,FSPGL_PROC,& + & KFLDPTRUV,KFLDPTRSC) +ENDIF +IF (LHOOK) CALL DR_HOOK('ELTINV_MOD:ELTINV',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE ELTINV +END MODULE ELTINV_MOD + diff --git a/src/etrans/etrans/internal/eltinvad_mod.F90 b/src/etrans/etrans/internal/eltinvad_mod.F90 new file mode 100644 index 000000000..a332b2eb3 --- /dev/null +++ b/src/etrans/etrans/internal/eltinvad_mod.F90 @@ -0,0 +1,252 @@ +MODULE ELTINVAD_MOD +CONTAINS +SUBROUTINE ELTINVAD(KF_OUT_LT,KF_UV,KF_SCALARS,KF_SCDERS,KLEI2,& + & PSPVOR,PSPDIV,PSPSCALAR,PSPSC3A,PSPSC3B,PSPSC2,& + & KFLDPTRUV,KFLDPTRSC,FSPGL_PROC,PSPMEANU,PSPMEANV) + +!**** *ELTINVAD* - Control routine for inverse Legandre transform - adj. + +! Purpose. +! -------- +! Control routine for the inverse LEGENDRE transform + +!** Interface. +! ---------- +! CALL ELTINVAD(...) +! KF_OUT_LT - number of fields coming out from inverse LT +! KF_UV - local number of spectral u-v fields +! KF_SCALARS - local number of scalar spectral fields +! KF_SCDERS - local number of derivatives of scalar spectral fields +! PSPVOR(:,:) - spectral vorticity (input) +! PSPDIV(:,:) - spectral divergence (input) +! PSPSCALAR(:,:) - spectral scalarvalued fields (input) +! KFLDPTRUV(:) - field pointer array for vor./div. +! KFLDPTRSC(:) - field pointer array for PSPSCALAR +! FSPGL_PROC - external procedure to be executed in fourier space +! before transposition + +! Method. +! ------- + +! Externals. +! ---------- + +! Author. +! ------- +! Mats Hamrud *ECMWF* + +! Modifications. +! -------------- +! Original : 00-02-01 From LTINVAD in IFS CY22R1 +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! 01-Dec-2004 A. Deckmyn add KMLOC to EVDTUVAD call +! D. Degrauwe (Feb 2012): Alternative extension zone (E') +! N. Lopes & R. El Khatib 15-Jun-2012 Scalability enhancement + +! thread-safety +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_GEN +USE TPM_DIM ,ONLY : R +USE TPMALD_DIM ,ONLY : RALD +USE TPM_TRANS ,ONLY : LDIVGP, LVORGP, NF_SC2, NF_SC3A, NF_SC3B +USE TPM_DISTR + +USE EASRE1BAD_MOD ,ONLY : EASRE1BAD +USE ELEINVAD_MOD ,ONLY : ELEINVAD +USE EPRFI1BAD_MOD ,ONLY : EPRFI1BAD +USE ESPNSDEAD_MOD ,ONLY : ESPNSDEAD +USE EVDTUVAD_MOD ,ONLY : EVDTUVAD +USE EVDTUVAD_COMM_MOD +USE EXTPER_MOD ,ONLY : EXTPER + +IMPLICIT NONE + +INTEGER(KIND=JPIM), INTENT(IN) :: KF_OUT_LT +INTEGER(KIND=JPIM), INTENT(IN) :: KF_UV +INTEGER(KIND=JPIM), INTENT(IN) :: KF_SCALARS +INTEGER(KIND=JPIM), INTENT(IN) :: KF_SCDERS +INTEGER(KIND=JPIM), INTENT(IN) :: KLEI2 + +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPVOR(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPDIV(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPSCALAR(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPSC2(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPSC3A(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPSC3B(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPMEANU(:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPMEANV(:) + +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KFLDPTRUV(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KFLDPTRSC(:) + +EXTERNAL FSPGL_PROC +OPTIONAL FSPGL_PROC + +REAL(KIND=JPRB) :: ZIA(RALD%NDGLSUR+R%NNOEXTZG,KLEI2,D%NUMP) +REAL(KIND=JPRB) :: ZIA2(KLEI2,RALD%NDGLSUR+R%NNOEXTZG) + +INTEGER(KIND=JPIM) :: IFC, ISTA, IINDEX(2*KF_OUT_LT), JF, JDIM, IM, JM +INTEGER(KIND=JPIM) :: IVORL,IVORU,IDIVL,IDIVU,IUL,IUU,IVL,IVU,ISL,ISU,IDL,IDU +INTEGER(KIND=JPIM) :: ILAST,IFIRST,IDIM1,IDIM3,J3 + +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +IF (LHOOK) CALL DR_HOOK('ELTINVAD_MOD:ELTINVAD',0,ZHOOK_HANDLE) + +IF (KF_UV > 0) THEN + IVORL = 1 + IVORU = 2*KF_UV + IDIVL = 2*KF_UV+1 + IDIVU = 4*KF_UV + IUL = 4*KF_UV+1 + IUU = 6*KF_UV + IVL = 6*KF_UV+1 + IVU = 8*KF_UV +ENDIF +ISTA = 1 +IFC = 2*KF_OUT_LT +IF(KF_UV > 0 .AND. .NOT. LVORGP) THEN + ISTA = ISTA+2*KF_UV +ENDIF +IF(KF_UV > 0 .AND. .NOT. LDIVGP) THEN + ISTA = ISTA+2*KF_UV +ENDIF +IF (KF_SCDERS > 0) THEN + ISL = 2*(4*KF_UV)+1 + ISU = ISL+2*KF_SCALARS-1 + IDL = 2*(4*KF_UV+KF_SCALARS)+1 + IDU = IDL+2*KF_SCDERS-1 +ENDIF + +!$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) PRIVATE(JM,IM,JF,JDIM,IINDEX,ZIA2) +DO JM=1,D%NUMP + IM = D%MYMS(JM) + +! 7. OPTIONAL COMPUTATIONS IN FOURIER SPACE +! -------------------------------------- + +!commented IF(PRESENT(FSPGL_PROC)) THEN +!commented CALL FSPGL_INT(IM,JM,FSPGL_PROC) +!commented ENDIF + + +!* 6. RECOMBINATION SYMMETRIC/ANTISYMMETRIC PART. +! -------------------------------------------- + + ZIA(:,:,JM)=0.0_JPRB + CALL EASRE1BAD(IFC,IM,JM,ZIA(:,ISTA:ISTA+IFC-1,JM)) + + +!* 5. PERIODICIZATION IN Y DIRECTION +! ------------------------------ + + IF(R%NNOEXTZG>0) THEN + DO JF = 1,IFC + DO JDIM = 1,R%NDGL + ZIA2(JF,JDIM)=ZIA(JDIM,JF,JM) + ENDDO + ENDDO + IINDEX(1)=0 + CALL EXTPER(ZIA2(:,:),R%NDGL+R%NNOEXTZG,1,R%NDGL,IFC,1,IINDEX,0) + DO JF = 1,IFC + DO JDIM = 1,R%NDGL+R%NNOEXTZG + ZIA(JDIM,JF,JM) = ZIA2(JF,JDIM) + ENDDO + ENDDO + ENDIF + +!* 4. INVERSE LEGENDRE TRANSFORM. +! --------------------------- + + CALL ELEINVAD(IM,IFC,KF_OUT_LT,ZIA(:,ISTA:ISTA+IFC-1,JM)) + + +!* 3. SPECTRAL COMPUTATIONS FOR U,V AND DERIVATIVES. +! ---------------------------------------------- + + ZIA(:,1:ISTA-1,JM) = 0.0_JPRB + + IF (KF_UV > 0) THEN + CALL EVDTUVAD(IM,JM,KF_UV,KFLDPTRUV,ZIA(:,IVORL:IVORU,JM),ZIA(:,IDIVL:IDIVU,JM),& + & ZIA(:,IUL:IUU,JM),ZIA(:,IVL:IVU,JM),PSPMEANU,PSPMEANV) + ENDIF + + +ENDDO +!$OMP END PARALLEL DO + +!* 2. COMMUNICATION OF MEAN WIND +! -------------------------- + +IF (KF_UV > 0) THEN + DO JM=1,D%NUMP + IM = D%MYMS(JM) + CALL EVDTUVAD_COMM(IM,JM,KF_UV,KFLDPTRUV,PSPMEANU,PSPMEANV) + ENDDO +ENDIF + +!* 2. PREPARE SPECTRAL FIELDS +! ----------------------- + +!$OMP PARALLEL DO SCHEDULE(DYNAMIC,1) PRIVATE(JM,IM,IFIRST,ILAST,IDIM1,IDIM3) +DO JM=1,D%NUMP + IM = D%MYMS(JM) + + IFIRST = 1 + ILAST = 4*KF_UV + IF (KF_UV > 0) THEN + CALL EPRFI1BAD(IM,ZIA(:,IVORL:IVORU,JM),PSPVOR,KF_UV,KFLDPTRUV) + CALL EPRFI1BAD(IM,ZIA(:,IDIVL:IDIVU,JM),PSPDIV,KF_UV,KFLDPTRUV) + ILAST = ILAST+4*KF_UV + ENDIF + + IF (KF_SCDERS > 0) THEN + CALL ESPNSDEAD(IM,KF_SCALARS,ZIA(:,ISL:ISU,JM),ZIA(:,IDL:IDU,JM)) + ENDIF + + IF(KF_SCALARS > 0)THEN + IF(PRESENT(PSPSCALAR)) THEN + IFIRST = ILAST+1 + ILAST = IFIRST - 1 + 2*KF_SCALARS + CALL EPRFI1BAD(IM,ZIA(:,IFIRST:ILAST,JM),PSPSCALAR(:,:),KF_SCALARS,KFLDPTRSC) + ELSE + IF(PRESENT(PSPSC2) .AND. NF_SC2 > 0) THEN + IFIRST = ILAST+1 + ILAST = IFIRST-1+2*NF_SC2 + CALL EPRFI1BAD(IM,ZIA(:,IFIRST:ILAST,JM),PSPSC2(:,:),NF_SC2) + ENDIF + IF(PRESENT(PSPSC3A) .AND. NF_SC3A > 0) THEN + IDIM1=NF_SC3A + IDIM3=UBOUND(PSPSC3A,3) + DO J3=1,IDIM3 + IFIRST = ILAST+1 + ILAST = IFIRST-1+2*IDIM1 + CALL EPRFI1BAD(IM,ZIA(:,IFIRST:ILAST,JM),PSPSC3A(:,:,J3),IDIM1) + ENDDO + ENDIF + IF(PRESENT(PSPSC3B) .AND. NF_SC3B > 0) THEN + IDIM1=NF_SC3B + IDIM3=UBOUND(PSPSC3B,3) + DO J3=1,IDIM3 + IFIRST = ILAST+1 + ILAST = IFIRST-1+2*IDIM1 + CALL EPRFI1BAD(IM,ZIA(:,IFIRST:ILAST,JM),PSPSC3B(:,:,J3),IDIM1) + ENDDO + ENDIF + ENDIF + ENDIF + +ENDDO +!$OMP END PARALLEL DO + +IF (LHOOK) CALL DR_HOOK('ELTINVAD_MOD:ELTINVAD',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE ELTINVAD +END MODULE ELTINVAD_MOD diff --git a/src/etrans/etrans/internal/eprfi1_mod.F90 b/src/etrans/etrans/internal/eprfi1_mod.F90 new file mode 100644 index 000000000..3e3feca51 --- /dev/null +++ b/src/etrans/etrans/internal/eprfi1_mod.F90 @@ -0,0 +1,105 @@ +MODULE EPRFI1_MOD +CONTAINS +SUBROUTINE EPRFI1(KM,KF_UV,KF_SCALARS,PIA,PSPVOR,PSPDIV,PSPSCALAR,& + & KFLDPTRUV,KFLDPTRSC) + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +!USE TPM_DISTR +!USE TPM_TRANS + +USE EPRFI1B_MOD ,ONLY : EPRFI1B + +!**** *PRFI1* - Prepare spectral fields for inverse Legendre transform + +! Purpose. +! -------- +! To extract the spectral fields for a specific zonal wavenumber +! and put them in an order suitable for the inverse Legendre . +! tranforms.The ordering is from NSMAX to KM for better conditioning. +! Elements 1,2 and NLCM(KM)+1 are zeroed in preparation for computing +! u,v and derivatives in spectral space. + +!** Interface. +! ---------- +! *CALL* *EPRFI1(KM,PIA,PSPVOR,PSPDIV,PSPSCALAR + +! Explicit arguments : KM - zonal wavenumber +! ------------------ PIA - spectral components for transform +! PSPVOR - vorticity +! PSPDIV - divergence +! PSPSCALAR - scalar variables + +! Implicit arguments : None. +! -------------------- + +! Method. +! ------- + +! Externals. None. +! ---------- + +! Reference. +! ---------- +! ECMWF Research Department documentation of the IFS + +! Author. +! ------- +! Mats Hamrud and Philippe Courtier *ECMWF* + +! Modifications. +! -------------- +! Original : 00-02-01 From PRFI1 in IFS CY22R1 +! M.Hamrud 01-Oct-2003 CY28 Cleaning + +! ------------------------------------------------------------------ + +IMPLICIT NONE + +INTEGER(KIND=JPIM),INTENT(IN) :: KM +INTEGER(KIND=JPIM),INTENT(IN) :: KF_UV +INTEGER(KIND=JPIM),INTENT(IN) :: KF_SCALARS +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPVOR(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPDIV(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPSCALAR(:,:) +REAL(KIND=JPRB) , INTENT(OUT) :: PIA(:,:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KFLDPTRUV(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KFLDPTRSC(:) + +INTEGER(KIND=JPIM) :: IDIV, IFIRST, ILAST, IVOR +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +!* 1. EXTRACT FIELDS FROM SPECTRAL ARRAYS. +! ------------------------------------ + +IF (LHOOK) CALL DR_HOOK('EPRFI1_MOD:EPRFI1',0,ZHOOK_HANDLE) +IFIRST = 1 +ILAST = 4*KF_UV + +!* 1.1 VORTICITY AND DIVERGENCE. + +IF(KF_UV > 0)THEN + IVOR = 1 + IDIV = 2*KF_UV+1 + CALL EPRFI1B(KM,PIA(:,IVOR:IDIV-1),PSPVOR,KF_UV,KFLDPTRUV) + CALL EPRFI1B(KM,PIA(:,IDIV:ILAST) ,PSPDIV,KF_UV,KFLDPTRUV) + ILAST = ILAST+4*KF_UV +ENDIF + +!* 1.2 SCALAR VARIABLES. + +IF(KF_SCALARS > 0)THEN + IFIRST = ILAST+1 + ILAST = IFIRST - 1 + 2*KF_SCALARS + CALL EPRFI1B(KM,PIA(:,IFIRST:ILAST),PSPSCALAR(:,:),KF_SCALARS,KFLDPTRSC) +ENDIF +IF (LHOOK) CALL DR_HOOK('EPRFI1_MOD:EPRFI1',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE EPRFI1 +END MODULE EPRFI1_MOD + diff --git a/src/etrans/etrans/internal/eprfi1ad_mod.F90 b/src/etrans/etrans/internal/eprfi1ad_mod.F90 new file mode 100644 index 000000000..ad7cd1725 --- /dev/null +++ b/src/etrans/etrans/internal/eprfi1ad_mod.F90 @@ -0,0 +1,103 @@ +MODULE EPRFI1AD_MOD +CONTAINS +SUBROUTINE EPRFI1AD(KM,KF_UV,KF_SCALARS,PIA,PSPVOR,PSPDIV,PSPSCALAR,& + & KFLDPTRUV,KFLDPTRSC) + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +!USE TPM_DISTR +!USE TPM_TRANS + +USE EPRFI1BAD_MOD ,ONLY : EPRFI1BAD + +!**** *EPRFI1AD* - Prepare spectral fields for inverse Legendre transform + +! Purpose. +! -------- +! To extract the spectral fields for a specific zonal wavenumber +! and put them in an order suitable for the inverse Legendre . +! tranforms.The ordering is from NSMAX to KM for better conditioning. +! Elements 1,2 and NLCM(KM)+1 are zeroed in preparation for computing +! u,v and derivatives in spectral space. + +!** Interface. +! ---------- +! *CALL* *EPRFI1AD(KM,PIA,PSPVOR,PSPDIV,PSPSCALAR + +! Explicit arguments : KM - zonal wavenumber +! ------------------ PIA - spectral components for transform +! PSPVOR - vorticity +! PSPDIV - divergence +! PSPSCALAR - scalar variables + +! Implicit arguments : None. +! -------------------- + +! Method. +! ------- + +! Externals. None. +! ---------- + +! Reference. +! ---------- +! ECMWF Research Department documentation of the IFS + +! Author. +! ------- +! Mats Hamrud and Philippe Courtier *ECMWF* + +! Modifications. +! -------------- +! Original : 00-02-01 From PRFI1AD in IFS CY22R1 +! M.Hamrud 01-Oct-2003 CY28 Cleaning + +! ------------------------------------------------------------------ +! +IMPLICIT NONE +! +! +INTEGER(KIND=JPIM),INTENT(IN) :: KM,KF_UV,KF_SCALARS +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPVOR(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPDIV(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPSCALAR(:,:) +REAL(KIND=JPRB) , INTENT(IN) :: PIA(:,:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KFLDPTRUV(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KFLDPTRSC(:) + +INTEGER(KIND=JPIM) :: IDIV, IFIRST, ILAST, IVOR +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +!* 1. EXTRACT FIELDS FROM SPECTRAL ARRAYS. +! ------------------------------------ + +IF (LHOOK) CALL DR_HOOK('EPRFI1AD_MOD:EPRFI1AD',0,ZHOOK_HANDLE) +IFIRST = 1 +ILAST = 4*KF_UV + +!* 1.1 VORTICITY AND DIVERGENCE. + +IF(KF_UV > 0)THEN + IVOR = 1 + IDIV = 2*KF_UV+1 + CALL EPRFI1BAD(KM,PIA(:,IVOR:IDIV-1),PSPVOR,KF_UV,KFLDPTRUV) + CALL EPRFI1BAD(KM,PIA(:,IDIV:ILAST) ,PSPDIV,KF_UV,KFLDPTRUV) + ILAST = ILAST+4*KF_UV +ENDIF + +!* 1.2 SCALAR VARIABLES. + +IF(KF_SCALARS > 0)THEN + IFIRST = ILAST+1 + ILAST = IFIRST - 1 + 2*KF_SCALARS + CALL EPRFI1BAD(KM,PIA(:,IFIRST:ILAST),PSPSCALAR(:,:),KF_SCALARS,KFLDPTRSC) +ENDIF +IF (LHOOK) CALL DR_HOOK('EPRFI1AD_MOD:EPRFI1AD',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE EPRFI1AD +END MODULE EPRFI1AD_MOD diff --git a/src/etrans/etrans/internal/eprfi1b_mod.F90 b/src/etrans/etrans/internal/eprfi1b_mod.F90 new file mode 100644 index 000000000..1a64daf29 --- /dev/null +++ b/src/etrans/etrans/internal/eprfi1b_mod.F90 @@ -0,0 +1,110 @@ +MODULE EPRFI1B_MOD +CONTAINS +SUBROUTINE EPRFI1B(KM,PIA,PSPEC,KFIELDS,KFLDPTR) + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +!USE TPM_DIM +!USE TPM_DISTR +USE TPMALD_DISTR ,ONLY : DALD +! +!**** *PRFI1* - Prepare spectral fields for inverse Legendre transform + +! Purpose. +! -------- +! To extract the spectral fields for a specific zonal wavenumber +! and put them in an order suitable for the inverse Legendre . +! tranforms.The ordering is from NSMAX to KM for better conditioning. +! Elements 1,2 and NLCM(KM)+1 are zeroed in preparation for computing +! u,v and derivatives in spectral space. + +!** Interface. +! ---------- +! *CALL* *PRFI1B(...)* + +! Explicit arguments : KM - zonal wavenumber +! ------------------ PIA - spectral components for transform +! PSPEC - spectral array +! KFIELDS - number of fields + +! Implicit arguments : None. +! -------------------- + +! Method. +! ------- + +! Externals. None. +! ---------- + +! Reference. +! ---------- +! ECMWF Research Department documentation of the IFS + +! Author. +! ------- +! Mats Hamrud and Philippe Courtier *ECMWF* + +! Modifications. +! -------------- +! Original : 00-02-01 From PRFI1B in IFS CY22R1 +! M.Hamrud 01-Oct-2003 CY28 Cleaning + +! ------------------------------------------------------------------ + +IMPLICIT NONE + +INTEGER(KIND=JPIM),INTENT(IN) :: KM,KFIELDS +REAL(KIND=JPRB) ,INTENT(IN) :: PSPEC(:,:) +REAL(KIND=JPRB) ,INTENT(OUT) :: PIA(:,:) +INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KFLDPTR(:) + +INTEGER(KIND=JPIM) :: II, INM, IR, J, JFLD, ILCM, IOFF,IFLD +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +!* 1. EXTRACT FIELDS FROM SPECTRAL ARRAYS. +! -------------------------------------------------- + +IF (LHOOK) CALL DR_HOOK('EPRFI1B_MOD:EPRFI1B',0,ZHOOK_HANDLE) +ILCM = DALD%NCPL2M(KM) +IOFF = DALD%NESM0(KM) + +IF(PRESENT(KFLDPTR)) THEN + DO JFLD=1,KFIELDS + IR = 2*(JFLD-1)+1 + II = IR+1 + IFLD = KFLDPTR(JFLD) + DO J=1,ILCM,2 + INM = IOFF+(J-1)*2 + PIA(J ,IR) = PSPEC(IFLD,INM ) + PIA(J+1,IR) = PSPEC(IFLD,INM+1) + PIA(J ,II) = PSPEC(IFLD,INM+2) + PIA(J+1,II) = PSPEC(IFLD,INM+3) + ENDDO + ENDDO + +ELSE + DO J=1,ILCM,2 + INM = IOFF+(J-1)*2 + !DIR$ IVDEP + !OCL NOVREC + !cdir unroll=4 + DO JFLD=1,KFIELDS + IR = 2*(JFLD-1)+1 + II = IR+1 + PIA(J ,IR) = PSPEC(JFLD,INM ) + PIA(J+1,IR) = PSPEC(JFLD,INM+1) + PIA(J ,II) = PSPEC(JFLD,INM+2) + PIA(J+1,II) = PSPEC(JFLD,INM+3) + ENDDO + ENDDO + +ENDIF +IF (LHOOK) CALL DR_HOOK('EPRFI1B_MOD:EPRFI1B',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE EPRFI1B +END MODULE EPRFI1B_MOD diff --git a/src/etrans/etrans/internal/eprfi1bad_mod.F90 b/src/etrans/etrans/internal/eprfi1bad_mod.F90 new file mode 100644 index 000000000..81a31ea69 --- /dev/null +++ b/src/etrans/etrans/internal/eprfi1bad_mod.F90 @@ -0,0 +1,110 @@ +MODULE EPRFI1BAD_MOD +CONTAINS +SUBROUTINE EPRFI1BAD(KM,PIA,PSPEC,KFIELDS,KFLDPTR) + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPMALD_DISTR ,ONLY : DALD + +!**** *EPRFI1BAD* - Prepare spectral fields for inverse Legendre transform + +! Purpose. +! -------- +! To extract the spectral fields for a specific zonal wavenumber +! and put them in an order suitable for the inverse Legendre . +! tranforms.The ordering is from NSMAX to KM for better conditioning. +! Elements 1,2 and NLCM(KM)+1 are zeroed in preparation for computing +! u,v and derivatives in spectral space. + +!** Interface. +! ---------- +! *CALL* *EPRFI1BAD(...)* + +! Explicit arguments : KM - zonal wavenumber +! ------------------ PIA - spectral components for transform +! PSPEC - spectral array +! KFIELDS - number of fields + +! Implicit arguments : None. +! -------------------- + +! Method. +! ------- + +! Externals. None. +! ---------- + +! Reference. +! ---------- +! ECMWF Research Department documentation of the IFS + +! Author. +! ------- +! Mats Hamrud and Philippe Courtier *ECMWF* + +! Modifications. +! -------------- +! Original : 00-02-01 From PRFI1BAD in IFS CY22R1 +! M.Hamrud 01-Oct-2003 CY28 Cleaning + +! ------------------------------------------------------------------ + +IMPLICIT NONE + +INTEGER(KIND=JPIM),INTENT(IN) :: KM,KFIELDS +REAL(KIND=JPRB) ,INTENT(INOUT) :: PSPEC(:,:) +REAL(KIND=JPRB) ,INTENT(IN) :: PIA(:,:) +INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KFLDPTR(:) + +INTEGER(KIND=JPIM) :: II, INM, IR, J, JFLD, ILCM, IOFF, IFLD +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +!* 1. EXTRACT FIELDS FROM SPECTRAL ARRAYS. +! -------------------------------------------------- + +IF (LHOOK) CALL DR_HOOK('EPRFI1BAD_MOD:EPRFI1BAD',0,ZHOOK_HANDLE) +ILCM=DALD%NCPL2M(KM) + +IOFF = DALD%NESM0(KM) + +IF(PRESENT(KFLDPTR)) THEN + DO JFLD=1,KFIELDS + IR = 2*(JFLD-1)+1 + II = IR+1 + IFLD = KFLDPTR(JFLD) + DO J=1,ILCM,2 + INM = IOFF+(J-1)*2 + + PSPEC(IFLD,INM ) = PSPEC(IFLD,INM ) + PIA(J ,IR) + PSPEC(IFLD,INM+1) = PSPEC(IFLD,INM+1) + PIA(J+1,IR) + PSPEC(IFLD,INM+2) = PSPEC(IFLD,INM+2) + PIA(J ,II) + PSPEC(IFLD,INM+3) = PSPEC(IFLD,INM+3) + PIA(J+1,II) + + ENDDO + ENDDO +ELSE + DO J=1,ILCM,2 + INM = IOFF+(J-1)*2 +!DIR$ IVDEP +!OCL NOVREC + DO JFLD=1,KFIELDS + IR = 2*(JFLD-1)+1 + II = IR+1 + + PSPEC(JFLD,INM ) = PSPEC(JFLD,INM ) + PIA(J ,IR) + PSPEC(JFLD,INM+1) = PSPEC(JFLD,INM+1) + PIA(J+1,IR) + PSPEC(JFLD,INM+2) = PSPEC(JFLD,INM+2) + PIA(J ,II) + PSPEC(JFLD,INM+3) = PSPEC(JFLD,INM+3) + PIA(J+1,II) + + ENDDO + ENDDO +ENDIF +IF (LHOOK) CALL DR_HOOK('EPRFI1BAD_MOD:EPRFI1BAD',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE EPRFI1BAD +END MODULE EPRFI1BAD_MOD diff --git a/src/etrans/etrans/internal/eprfi2_mod.F90 b/src/etrans/etrans/internal/eprfi2_mod.F90 new file mode 100644 index 000000000..35c418bf1 --- /dev/null +++ b/src/etrans/etrans/internal/eprfi2_mod.F90 @@ -0,0 +1,85 @@ +MODULE EPRFI2_MOD +CONTAINS +SUBROUTINE EPRFI2(KM,KMLOC,KF_FS,PFFT) + +!**** *EPRFI2* - Prepare input work arrays for direct transform + +! Purpose. +! -------- +! To extract the Fourier fields for a specific zonal wavenumber +! and put them in an order suitable for the direct Legendre +! tranforms, i.e. split into symmetric and anti-symmetric part. + +!** Interface. +! ---------- +! *CALL* *EPRFI2(..) + +! Explicit arguments : +! -------------------- KM - zonal wavenumber +! KMLOC - local zonal wavenumber +! PAIA - antisymmetric part of Fourier +! components for KM (output) +! PSIA - symmetric part of Fourier +! components for KM (output) + +! Implicit arguments : The Grid point arrays of the model. +! -------------------- + +! Method. +! ------- + +! Externals. PRFI2B - basic copying routine +! ---------- + +! Reference. +! ---------- +! ECMWF Research Department documentation of the IFS + +! Author. +! ------- +! Mats Hamrud and Philippe Courtier *ECMWF* + +! Modifications. +! -------------- +! Original : 87-11-25 +! Modified : 91-07-01 Philippe Courtier/Mats Hamrud - Rewrite +! for uv formulation +! Modified : 93-03-19 D. Giard - CDCONF='T' +! Modified : 93-??-?? ???????? - CDCONF='C'--> bug if CDCONF='T' +! Modified : 93-05-13 D. Giard - correction of the previous bug +! Modified : 93-11-18 M. Hamrud - use only one Fourier buffer +! Modified : 94-04-06 R. El Khatib - Full-POS configuration 'P' +! M.Hamrud : 94-11-01 New conf 'G' - vor,div->vor,div +! instead of u,v->vor,div +! MPP Group: 95-10-01 Support for Distributed Memory version +! Modified : 04/06/99 D.Salmond : change order of AIA and SIA +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK + +!USE TPM_TRANS + +USE EPRFI2B_MOD ,ONLY : EPRFI2B +! + +IMPLICIT NONE + +INTEGER(KIND=JPIM) , INTENT(IN) :: KM +INTEGER(KIND=JPIM) , INTENT(IN) :: KMLOC +INTEGER(KIND=JPIM) , INTENT(IN) :: KF_FS + +REAL(KIND=JPRB) , INTENT(OUT) :: PFFT(:,:) + +! ------------------------------------------------------------------ + +!* 2. EXTRACT SYM./ANTISYM. FIELDS FROM TIME T+1. +! ------------------------------------------- + +CALL EPRFI2B(KF_FS,KM,KMLOC,PFFT) + +! ------------------------------------------------------------------ + +END SUBROUTINE EPRFI2 +END MODULE EPRFI2_MOD diff --git a/src/etrans/etrans/internal/eprfi2ad_mod.F90 b/src/etrans/etrans/internal/eprfi2ad_mod.F90 new file mode 100644 index 000000000..186dc29e4 --- /dev/null +++ b/src/etrans/etrans/internal/eprfi2ad_mod.F90 @@ -0,0 +1,82 @@ +MODULE EPRFI2AD_MOD +CONTAINS +SUBROUTINE EPRFI2AD(KM,KMLOC,KF_FS,PFFT) + +!**** *EPRFI2AD* - Prepare input work arrays for direct transform + +! Purpose. +! -------- +! To extract the Fourier fields for a specific zonal wavenumber +! and put them in an order suitable for the direct Legendre +! tranforms, i.e. split into symmetric and anti-symmetric part. + +!** Interface. +! ---------- +! *CALL* *EPRFI2AD(..) + +! Explicit arguments : +! -------------------- KM - zonal wavenumber +! KMLOC - local zonal wavenumber +! PAIA - antisymmetric part of Fourier +! components for KM (output) +! PSIA - symmetric part of Fourier +! components for KM (output) + +! Implicit arguments : The Grid point arrays of the model. +! -------------------- + +! Method. +! ------- + +! Externals. EPRFI2BAD - basic copying routine +! ---------- + +! Reference. +! ---------- +! ECMWF Research Department documentation of the IFS + +! Author. +! ------- +! Mats Hamrud and Philippe Courtier *ECMWF* + +! Modifications. +! -------------- +! Original : 87-11-25 +! Modified : 91-07-01 Philippe Courtier/Mats Hamrud - Rewrite +! for uv formulation +! Modified : 93-03-19 D. Giard - CDCONF='T' +! Modified : 93-??-?? ???????? - CDCONF='C'--> bug if CDCONF='T' +! Modified : 93-05-13 D. Giard - correction of the previous bug +! Modified : 93-11-18 M. Hamrud - use only one Fourier buffer +! Modified : 94-04-06 R. El Khatib - Full-POS configuration 'P' +! M.Hamrud : 94-11-01 New conf 'G' - vor,div->vor,div +! instead of u,v->vor,div +! MPP Group: 95-10-01 Support for Distributed Memory version +! Modified : 04/06/99 D.Salmond : change order of AIA and SIA +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB + +USE EPRFI2BAD_MOD ,ONLY : EPRFI2BAD +! + +IMPLICIT NONE + +INTEGER(KIND=JPIM) , INTENT(IN) :: KM +INTEGER(KIND=JPIM) , INTENT(IN) :: KMLOC +INTEGER(KIND=JPIM) , INTENT(IN) :: KF_FS + +REAL(KIND=JPRB) , INTENT(IN) :: PFFT(:,:) + +! ------------------------------------------------------------------ + +!* 2. EXTRACT SYM./ANTISYM. FIELDS FROM TIME T+1. +! ------------------------------------------- + +CALL EPRFI2BAD(KF_FS,KM,KMLOC,PFFT) + +! ------------------------------------------------------------------ + +END SUBROUTINE EPRFI2AD +END MODULE EPRFI2AD_MOD diff --git a/src/etrans/etrans/internal/eprfi2b_mod.F90 b/src/etrans/etrans/internal/eprfi2b_mod.F90 new file mode 100644 index 000000000..6c304d81c --- /dev/null +++ b/src/etrans/etrans/internal/eprfi2b_mod.F90 @@ -0,0 +1,92 @@ +MODULE EPRFI2B_MOD +CONTAINS +SUBROUTINE EPRFI2B(KFIELD,KM,KMLOC,PFFT) + +!**** *EPRFI2B* - Prepare input work arrays for direct transform + +! Purpose. +! -------- +! To extract the Fourier fields for a specific zonal wavenumber +! and put them in an order suitable for the direct Legendre +! tranforms, i.e. split into symmetric and anti-symmetric part. + +!** Interface. +! ---------- +! *CALL* *EPRFI2B(..) + +! Explicit arguments : +! ------------------- KFIELD - number of fields +! KM - zonal wavenumber +! KMLOC - local zonal wavenumber +! PAOA - antisymmetric part of Fourier +! fields for zonal wavenumber KM +! PSOA - symmetric part of Fourier +! fields for zonal wavenumber KM + +! Implicit arguments : FOUBUF in TPM_TRANS +! -------------------- + +! Method. +! ------- + +! Externals. None. +! ---------- + +! Reference. +! ---------- +! ECMWF Research Department documentation of the IFS + +! Author. +! ------- +! Mats Hamrud and Philippe Courtier *ECMWF* + +! Modifications. +! -------------- +! Original : 90-07-01 +! MPP Group: 95-10-01 Support for Distributed Memory version +! Modified : 04/06/99 D.Salmond : change order of AIA and SIA +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_DIM ,ONLY : R +USE TPM_TRANS ,ONLY : FOUBUF +!USE TPM_GEOMETRY +USE TPM_DISTR ,ONLY : D +!USE TPMALD_DIM ,ONLY : RALD +! + +IMPLICIT NONE + +INTEGER(KIND=JPIM),INTENT(IN) :: KFIELD,KM,KMLOC +REAL(KIND=JPRB) , INTENT(OUT) :: PFFT(:,:) +INTEGER(KIND=JPIM) :: ISTAN, JF, JGL +INTEGER(KIND=JPIM) :: IJR,IJI +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +IF (LHOOK) CALL DR_HOOK('EPRFI2B_MOD:EPRFI2B',0,ZHOOK_HANDLE) + +!* 1. EXTRACT SYM./ANTISYM. FIELDS FROM FOURIER ARRAY. +! ------------------------------------------------ + +!DIR$ IVDEP +!OCL NOVREC +DO JGL=1,R%NDGL + ISTAN = (D%NSTAGT1B(D%NPROCL(JGL) )+D%NPNTGTB1(KMLOC,JGL ))*2*KFIELD + DO JF =1,KFIELD + IJR = 2*(JF-1)+1 + IJI = IJR+1 + PFFT(JGL,IJR) = FOUBUF(ISTAN+IJR) + PFFT(JGL,IJI) = FOUBUF(ISTAN+IJI) + ENDDO +ENDDO +IF (LHOOK) CALL DR_HOOK('EPRFI2B_MOD:EPRFI2B',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE EPRFI2B +END MODULE EPRFI2B_MOD diff --git a/src/etrans/etrans/internal/eprfi2bad_mod.F90 b/src/etrans/etrans/internal/eprfi2bad_mod.F90 new file mode 100644 index 000000000..40865662b --- /dev/null +++ b/src/etrans/etrans/internal/eprfi2bad_mod.F90 @@ -0,0 +1,90 @@ +MODULE EPRFI2BAD_MOD +CONTAINS +SUBROUTINE EPRFI2BAD(KFIELD,KM,KMLOC,PFFT) + +!**** *EPRFI2BAD* - Prepare input work arrays for direct transform + +! Purpose. +! -------- +! To extract the Fourier fields for a specific zonal wavenumber +! and put them in an order suitable for the direct Legendre +! tranforms, i.e. split into symmetric and anti-symmetric part. + +!** Interface. +! ---------- +! *CALL* *EPRFI2BAD(..) + +! Explicit arguments : +! ------------------- KFIELD - number of fields +! KM - zonal wavenumber +! KMLOC - local zonal wavenumber +! PAOA - antisymmetric part of Fourier +! fields for zonal wavenumber KM +! PSOA - symmetric part of Fourier +! fields for zonal wavenumber KM + +! Implicit arguments : FOUBUF in TPM_TRANS +! -------------------- + +! Method. +! ------- + +! Externals. None. +! ---------- + +! Reference. +! ---------- +! ECMWF Research Department documentation of the IFS + +! Author. +! ------- +! Mats Hamrud and Philippe Courtier *ECMWF* + +! Modifications. +! -------------- +! Original : 90-07-01 +! MPP Group: 95-10-01 Support for Distributed Memory version +! Modified : 04/06/99 D.Salmond : change order of AIA and SIA +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_DIM ,ONLY : R +!USE TPMALD_DIM ,ONLY : RALD +USE TPM_TRANS ,ONLY : FOUBUF +!USE TPM_GEOMETRY +USE TPM_DISTR ,ONLY : D +! + +IMPLICIT NONE + +INTEGER(KIND=JPIM),INTENT(IN) :: KFIELD,KM,KMLOC +REAL(KIND=JPRB) , INTENT(IN) :: PFFT(:,:) + +INTEGER(KIND=JPIM) :: ISTAN, JF, JGL + +INTEGER(KIND=JPIM) :: IJR,IJI +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +!* 1. EXTRACT SYM./ANTISYM. FIELDS FROM FOURIER ARRAY. +! ------------------------------------------------ +IF (LHOOK) CALL DR_HOOK('EPRFI2BAD_MOD:EPRFI2BAD',0,ZHOOK_HANDLE) +DO JGL=1,R%NDGL + ISTAN = (D%NSTAGT1B(D%NPROCL(JGL) )+D%NPNTGTB1(KMLOC,JGL ))*2*KFIELD + DO JF =1,KFIELD + IJR = 2*(JF-1)+1 + IJI = IJR+1 + FOUBUF(ISTAN+IJR) = PFFT(JGL,IJR) + FOUBUF(ISTAN+IJI) = PFFT(JGL,IJI) + ENDDO +ENDDO +IF (LHOOK) CALL DR_HOOK('EPRFI2BAD_MOD:EPRFI2BAD',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE EPRFI2BAD +END MODULE EPRFI2BAD_MOD diff --git a/src/etrans/etrans/internal/eset_resol_mod.F90 b/src/etrans/etrans/internal/eset_resol_mod.F90 new file mode 100644 index 000000000..b5f1434a8 --- /dev/null +++ b/src/etrans/etrans/internal/eset_resol_mod.F90 @@ -0,0 +1,71 @@ +MODULE ESET_RESOL_MOD +CONTAINS +SUBROUTINE ESET_RESOL(KRESOL) +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_GEN ,ONLY : NOUT, MSETUP0, NCUR_RESOL, NMAX_RESOL +USE TPM_DIM ,ONLY : R, DIM_RESOL +!USE TPM_TRANS +USE TPM_DISTR ,ONLY : D, DISTR_RESOL +USE TPM_GEOMETRY ,ONLY : G, GEOM_RESOL +USE TPM_FIELDS ,ONLY : F, FIELDS_RESOL +USE TPM_FFT ,ONLY : T, FFT_RESOL, TB, FFTB_RESOL +#ifdef WITH_FFTW +USE TPM_FFTW ,ONLY : TW, FFTW_RESOL +#endif + +USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS + +USE TPMALD_DIM ,ONLY : RALD, ALDDIM_RESOL +USE TPMALD_DISTR ,ONLY : DALD, ALDDISTR_RESOL +USE TPMALD_FFT ,ONLY : TALD, ALDFFT_RESOL +USE TPMALD_FIELDS ,ONLY : FALD, ALDFIELDS_RESOL +USE TPMALD_GEO ,ONLY : GALD, ALDGEO_RESOL +! + +IMPLICIT NONE + +! Declaration of arguments + +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KRESOL + +! Local varaibles +INTEGER(KIND=JPIM) :: IRESOL +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +IF (LHOOK) CALL DR_HOOK('ESET_RESOL_MOD:ESET_RESOL',0,ZHOOK_HANDLE) +IF(MSETUP0 == 0) CALL ABORT_TRANS('ESET_RESOL:TRANS NOT SETUP') +IRESOL = 1 +IF(PRESENT(KRESOL)) THEN + IRESOL = KRESOL + IF(KRESOL < 1 .OR. KRESOL > NMAX_RESOL) THEN + WRITE(NOUT,*)'ESET_RESOL: UNKNOWN RESOLUTION ',KRESOL,NMAX_RESOL + CALL ABORT_TRANS('ESET_RESOL:KRESOL < 1 .OR. KRESOL > NMAX_RESOL') + ENDIF +ENDIF +IF(IRESOL /= NCUR_RESOL) THEN + NCUR_RESOL = IRESOL + R => DIM_RESOL(NCUR_RESOL) + F => FIELDS_RESOL(NCUR_RESOL) + G => GEOM_RESOL(NCUR_RESOL) + D => DISTR_RESOL(NCUR_RESOL) + T => FFT_RESOL(NCUR_RESOL) + TB => FFTB_RESOL(NCUR_RESOL) +#ifdef WITH_FFTW + TW => FFTW_RESOL(NCUR_RESOL) +#endif + + RALD => ALDDIM_RESOL(NCUR_RESOL) + DALD => ALDDISTR_RESOL(NCUR_RESOL) + TALD => ALDFFT_RESOL(NCUR_RESOL) + FALD => ALDFIELDS_RESOL(NCUR_RESOL) + GALD => ALDGEO_RESOL(NCUR_RESOL) + +ENDIF +IF (LHOOK) CALL DR_HOOK('ESET_RESOL_MOD:ESET_RESOL',1,ZHOOK_HANDLE) + +END SUBROUTINE ESET_RESOL +END MODULE ESET_RESOL_MOD diff --git a/src/etrans/etrans/internal/esetup_dims_mod.F90 b/src/etrans/etrans/internal/esetup_dims_mod.F90 new file mode 100644 index 000000000..077f2740f --- /dev/null +++ b/src/etrans/etrans/internal/esetup_dims_mod.F90 @@ -0,0 +1,46 @@ +MODULE ESETUP_DIMS_MOD +CONTAINS +SUBROUTINE ESETUP_DIMS + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_DIM ,ONLY : R +USE TPMALD_DIM ,ONLY : RALD +! + +IMPLICIT NONE + +INTEGER(KIND=JPIM) :: JM,JN,ISPOLEG +INTEGER(KIND=JPIM) :: ISMAX(0:R%NSMAX),ISNAX(0:RALD%NMSMAX) +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE +! ------------------------------------------------------------------ + +IF (LHOOK) CALL DR_HOOK('ESETUP_DIMS_MOD:ESETUP_DIMS',0,ZHOOK_HANDLE) +ISPOLEG = 0 +DO JM=0,R%NSMAX + DO JN=JM,R%NTMAX+1 + ISPOLEG = ISPOLEG+1 + ENDDO +ENDDO +R%NSPOLEG = ISPOLEG +CALL ELLIPS(R%NSMAX,RALD%NMSMAX,ISNAX,ISMAX) +R%NSPEC_G=0 +DO JM=0,RALD%NMSMAX + R%NSPEC_G=R%NSPEC_G+2*(ISNAX(JM)+1) +ENDDO +R%NSPEC2_G = R%NSPEC_G*2 + +R%NDGNH = (R%NDGL+1)/2 + +R%NLEI1 = R%NSMAX+4+MOD(R%NSMAX+4+1,2) +R%NLEI3 = R%NDGNH+MOD(R%NDGNH+2,2) + +R%NLED3 = R%NTMAX+2+MOD(R%NTMAX+3,2) +R%NLED4 = R%NTMAX+3+MOD(R%NTMAX+4,2) +IF (LHOOK) CALL DR_HOOK('ESETUP_DIMS_MOD:ESETUP_DIMS',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE ESETUP_DIMS +END MODULE ESETUP_DIMS_MOD diff --git a/src/etrans/etrans/internal/esetup_geom_mod.F90 b/src/etrans/etrans/internal/esetup_geom_mod.F90 new file mode 100644 index 000000000..a93c67d24 --- /dev/null +++ b/src/etrans/etrans/internal/esetup_geom_mod.F90 @@ -0,0 +1,66 @@ +MODULE ESETUP_GEOM_MOD +CONTAINS +SUBROUTINE ESETUP_GEOM + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_GEN ,ONLY : NOUT, NPRINTLEV +USE TPM_DIM ,ONLY : R +USE TPM_DISTR ,ONLY : D +USE TPMALD_DIM ,ONLY : RALD +!USE TPM_FIELDS +USE TPM_GEOMETRY ,ONLY : G +! + +IMPLICIT NONE + +INTEGER(KIND=JPIM) :: IDGLU(0:RALD%NMSMAX,R%NDGNH) +INTEGER(KIND=JPIM) :: JGL,JM + +LOGICAL :: LLP1,LLP2 +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +IF (LHOOK) CALL DR_HOOK('ESETUP_GEOM_MOD:ESETUP_GEOM',0,ZHOOK_HANDLE) +IF(.NOT.D%LGRIDONLY) THEN +LLP1 = NPRINTLEV>0 +LLP2 = NPRINTLEV>1 + +IF(LLP1) WRITE(NOUT,*) '=== ENTER ROUTINE SETUP_GEOM ===' + +ALLOCATE (G%NMEN(R%NDGL)) +IF(LLP2)WRITE(NOUT,9) 'G%NMEN ',SIZE(G%NMEN ),SHAPE(G%NMEN ) +G%NMEN(:)=RALD%NMSMAX +IF(LLP1) THEN + WRITE(NOUT,FMT='('' (JGL,G%NLOEN,G%NMEN) '')') + WRITE(NOUT,FMT='(8(1X,''('',I4,I4,I4,'')''))')& + & (JGL,G%NLOEN(JGL),G%NMEN(JGL),JGL=1,R%NDGL) +ENDIF +ALLOCATE(G%NDGLU(0:RALD%NMSMAX)) +IF(LLP2)WRITE(NOUT,9) 'G%NDGLU ',SIZE(G%NDGLU ),SHAPE(G%NDGLU ) +IDGLU(:,:) = 0 +G%NDGLU(:) = 0 +DO JGL=1,R%NDGNH + DO JM=0,G%NMEN(JGL) + IDGLU(JM,JGL) = 1 + ENDDO +ENDDO +DO JM=0,RALD%NMSMAX + DO JGL=1,R%NDGNH + G%NDGLU(JM) = G%NDGLU(JM)+IDGLU(JM,JGL) + ENDDO +ENDDO +IF(LLP1) THEN + WRITE(NOUT,FMT='('' (JM,G%NDGLU) '')') + WRITE(NOUT,FMT='(10(1X,''('',I4,I4,'')''))')& + & (JM,G%NDGLU(JM),JM=0,RALD%NMSMAX) +ENDIF +ENDIF +IF (LHOOK) CALL DR_HOOK('ESETUP_GEOM_MOD:ESETUP_GEOM',1,ZHOOK_HANDLE) +! ------------------------------------------------------------------ +9 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8) + +END SUBROUTINE ESETUP_GEOM +END MODULE ESETUP_GEOM_MOD diff --git a/src/etrans/etrans/internal/espnorm_ctl_mod.F90 b/src/etrans/etrans/internal/espnorm_ctl_mod.F90 new file mode 100644 index 000000000..6e0ad3aae --- /dev/null +++ b/src/etrans/etrans/internal/espnorm_ctl_mod.F90 @@ -0,0 +1,64 @@ +MODULE ESPNORM_CTL_MOD +CONTAINS +SUBROUTINE ESPNORM_CTL(PSPEC,KFLD,KFLD_G,KVSET,KMASTER,PMET,PNORM) + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK, JPHOOK + +USE TPM_DIM ,ONLY : R +USE TPM_DISTR ,ONLY : D, MYSETV, MYPROC + +USE ESPNORMD_MOD ,ONLY : ESPNORMD +USE SPNORMC_MOD ,ONLY : SPNORMC + +USE TPMALD_DIM ,ONLY : RALD +! + +IMPLICIT NONE + +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PSPEC(:,:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KVSET(:) +INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KMASTER +REAL(KIND=JPRB) ,OPTIONAL, INTENT(IN) :: PMET(:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PNORM(:) +INTEGER(KIND=JPIM) , INTENT(IN) :: KFLD,KFLD_G +INTEGER(KIND=JPIM) :: IVSET(KFLD_G) + +REAL(KIND=JPRB) :: ZMET(0:R%NSPEC_G) + +REAL(KIND=JPRB) :: ZSM(KFLD,D%NUMP) + +REAL(KIND=JPRB) :: ZGM(KFLD_G,0:RALD%NMSMAX) +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE1 + +! ------------------------------------------------------------------ + +IF (LHOOK) CALL DR_HOOK('ESPNORM_CTL_MOD:ESPNORM_CTL',0,ZHOOK_HANDLE) +IF(PRESENT(KVSET)) THEN + IVSET(:) = KVSET(:) +ELSE + IVSET(:) = MYSETV +ENDIF + +IF(PRESENT(PMET)) THEN + ZMET(:) = PMET(:) +ELSE + ZMET(:) = 1.0_JPRB +ENDIF + +CALL ESPNORMD(PSPEC,KFLD,ZMET,ZSM) + +IF (LHOOK) CALL DR_HOOK('ESPNORM_CTL_MOD:SPNORMC',0,ZHOOK_HANDLE1) +CALL SPNORMC(ZSM,KFLD_G,IVSET,KMASTER,RALD%NMSMAX,ZGM) +IF (LHOOK) CALL DR_HOOK('ESPNORM_CTL_MOD:SPNORMC',1,ZHOOK_HANDLE1) + +IF(MYPROC == KMASTER) THEN + PNORM(1:KFLD_G) = SUM(ZGM,DIM=2) + PNORM(1:KFLD_G) = SQRT(PNORM(1:KFLD_G)) +ENDIF +IF (LHOOK) CALL DR_HOOK('ESPNORM_CTL_MOD:ESPNORM_CTL',1,ZHOOK_HANDLE) +! ------------------------------------------------------------------ + +END SUBROUTINE ESPNORM_CTL +END MODULE ESPNORM_CTL_MOD diff --git a/src/etrans/etrans/internal/espnormc_mod.F90 b/src/etrans/etrans/internal/espnormc_mod.F90 new file mode 100644 index 000000000..4b56285f6 --- /dev/null +++ b/src/etrans/etrans/internal/espnormc_mod.F90 @@ -0,0 +1,3 @@ +MODULE ESPNORMC_MOD + ! dead code +END MODULE ESPNORMC_MOD diff --git a/src/etrans/etrans/internal/espnormd_mod.F90 b/src/etrans/etrans/internal/espnormd_mod.F90 new file mode 100644 index 000000000..75e245add --- /dev/null +++ b/src/etrans/etrans/internal/espnormd_mod.F90 @@ -0,0 +1,55 @@ +MODULE ESPNORMD_MOD +CONTAINS +SUBROUTINE ESPNORMD(PSPEC,KFLD,PMET,PSM) + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_DIM ,ONLY : R +USE TPM_DISTR ,ONLY : D + +USE TPMALD_DISTR ,ONLY : DALD +! + +IMPLICIT NONE + +REAL(KIND=JPRB) ,INTENT(IN) :: PSPEC(:,:) +REAL(KIND=JPRB) ,INTENT(IN) :: PMET(0:R%NSPEC_G) +INTEGER(KIND=JPIM) ,INTENT(IN) :: KFLD +REAL(KIND=JPRB) ,INTENT(OUT) :: PSM(:,:) +INTEGER(KIND=JPIM) :: JM ,JFLD ,JN ,IM ,ISP +INTEGER(KIND=JPIM) :: IN,ISPE +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +IF (LHOOK) CALL DR_HOOK('ESPNORMD_MOD:ESPNORMD',0,ZHOOK_HANDLE) + +!$OMP PARALLEL DO SCHEDULE(STATIC,1) PRIVATE(JM,IM,JN,ISP,JFLD,IN,ISPE) +DO JM=1,D%NUMP + PSM(:,JM) = 0.0_JPRB + IM = D%MYMS(JM) + + IN=DALD%NCPL2M(IM)/2 - 1 + DO JN=0,IN + ISP=DALD%NESM0(IM) + (JN)*4 + ISPE=DALD%NPME (IM) + JN + DO JFLD=1,KFLD + PSM(JFLD,JM) =PSM(JFLD,JM)& + & + PMET(ISPE) *& + & ( PSPEC(JFLD,ISP )**2 + PSPEC(JFLD,ISP+1)**2 +& + & PSPEC(JFLD,ISP+2)**2 + PSPEC(JFLD,ISP+3)**2 ) + + ENDDO + ENDDO + +ENDDO +!$OMP END PARALLEL DO + +IF (LHOOK) CALL DR_HOOK('ESPNORMD_MOD:ESPNORMD',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE ESPNORMD +END MODULE ESPNORMD_MOD + diff --git a/src/etrans/etrans/internal/espnsde_mod.F90 b/src/etrans/etrans/internal/espnsde_mod.F90 new file mode 100644 index 000000000..9160e61ce --- /dev/null +++ b/src/etrans/etrans/internal/espnsde_mod.F90 @@ -0,0 +1,101 @@ +MODULE ESPNSDE_MOD +CONTAINS +SUBROUTINE ESPNSDE(KM,KF_SCALARS,PF,PNSD) + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +!USE TPM_GEN +!USE TPM_DIM +!USE TPM_FIELDS +!USE TPM_TRANS +USE TPMALD_DISTR ,ONLY : DALD +USE TPMALD_GEO ,ONLY : GALD + + +!**** *SPNSDE* - Compute North-South derivative in spectral space + +! Purpose. +! -------- +! In Laplace space compute the the North-south derivative + +!** Interface. +! ---------- +! CALL SPNSDE(...) + +! Explicit arguments : +! -------------------- +! KM -zonal wavenumber (input-c) +! PEPSNM - REPSNM for wavenumber KM (input-c) +! PF (NLEI1,2*KF_SCALARS) - input field (input) +! PNSD(NLEI1,2*KF_SCALARS) - N-S derivative (output) + +! Organisation within NLEI1: +! NLEI1 = NSMAX+4+mod(NSMAX+4+1,2) +! overdimensioning +! 1 : n=NSMAX+2 +! 2 : n=NSMAX+1 +! 3 : n=NSMAX +! . : +! . : +! NSMAX+3 : n=0 +! NSMAX+4 : n=-1 + +! Implicit arguments : YOMLAP +! -------------------- + +! Method. +! ------- + +! Externals. None. +! ---------- + +! Reference. +! ---------- +! ECMWF Research Department documentation of the IFS +! Temperton, 1991, MWR 119 p1303 + +! Author. +! ------- +! Mats Hamrud and Philippe Courtier *ECMWF* + +! Modifications. +! -------------- +! Original : 00-02-01 From SPNSDE in IFS CY22R1 +! M.Hamrud 01-Oct-2003 CY28 Cleaning + +! ------------------------------------------------------------------ + +IMPLICIT NONE + +INTEGER(KIND=JPIM), INTENT(IN) :: KM +INTEGER(KIND=JPIM), INTENT(IN) :: KF_SCALARS +REAL(KIND=JPRB), INTENT(IN) :: PF(:,:) +REAL(KIND=JPRB), INTENT(OUT) :: PNSD(:,:) + +INTEGER(KIND=JPIM) :: J, JN,IN +REAL(KIND=JPRB) :: ZIN +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +!* 1. COMPUTE NORTH SOUTH DERIVATIVE. +! ------------------------------- + +!* 1.1 COMPUTE + +IF (LHOOK) CALL DR_HOOK('ESPNSDE_MOD:ESPNSDE',0,ZHOOK_HANDLE) +DO JN=1,DALD%NCPL2M(KM),2 + IN =(JN-1)/2 + ZIN = REAL(IN,JPRB)*GALD%EYWN + DO J=1,2*KF_SCALARS + PNSD(JN ,J) = -ZIN*PF(JN+1,J) + PNSD(JN+1,J) = ZIN*PF(JN,J) + ENDDO +ENDDO +IF (LHOOK) CALL DR_HOOK('ESPNSDE_MOD:ESPNSDE',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE ESPNSDE +END MODULE ESPNSDE_MOD diff --git a/src/etrans/etrans/internal/espnsdead_mod.F90 b/src/etrans/etrans/internal/espnsdead_mod.F90 new file mode 100644 index 000000000..3ca9ded9c --- /dev/null +++ b/src/etrans/etrans/internal/espnsdead_mod.F90 @@ -0,0 +1,112 @@ +MODULE ESPNSDEAD_MOD +CONTAINS +SUBROUTINE ESPNSDEAD(KM,KF_SCALARS,PF,PNSD) + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +!USE TPM_GEN +!USE TPM_DIM +!USE TPM_FIELDS +!USE TPM_TRANS + +USE TPMALD_DISTR ,ONLY : DALD +USE TPMALD_GEO ,ONLY : GALD + + +!**** *ESPNSDEAD* - Compute North-South derivative in spectral space + +! Purpose. +! -------- +! In Laplace space compute the the North-south derivative + +!** Interface. +! ---------- +! CALL ESPNSDEAD(...) + +! Explicit arguments : +! -------------------- +! KM -zonal wavenumber (input-c) +! PEPSNM - REPSNM for wavenumber KM (input-c) +! PF (NLEI1,2*KF_SCALARS) - input field (input) +! PNSD(NLEI1,2*KF_SCALARS) - N-S derivative (output) + +! Organisation within NLEI1: +! NLEI1 = NSMAX+4+mod(NSMAX+4+1,2) +! overdimensioning +! 1 : n=NSMAX+2 +! 2 : n=NSMAX+1 +! 3 : n=NSMAX +! . : +! . : +! NSMAX+3 : n=0 +! NSMAX+4 : n=-1 + +! Implicit arguments : YOMLAP +! -------------------- + +! Method. +! ------- + +! Externals. None. +! ---------- + +! Reference. +! ---------- +! ECMWF Research Department documentation of the IFS +! Temperton, 1991, MWR 119 p1303 + +! Author. +! ------- +! Mats Hamrud and Philippe Courtier *ECMWF* + +! Modifications. +! -------------- +! Original : 00-02-01 From SPNSDEAD in IFS CY22R1 +! M.Hamrud 01-Oct-2003 CY28 Cleaning + +! ------------------------------------------------------------------ + +IMPLICIT NONE + +INTEGER(KIND=JPIM), INTENT(IN) :: KM +INTEGER(KIND=JPIM), INTENT(IN) :: KF_SCALARS +REAL(KIND=JPRB), INTENT(INOUT) :: PF(:,:) +REAL(KIND=JPRB), INTENT(IN) :: PNSD(:,:) +INTEGER(KIND=JPIM) :: ISKIP, J, JN +INTEGER(KIND=JPIM) :: IN +REAL(KIND=JPRB) :: ZIN +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +!* 1. COMPUTE NORTH SOUTH DERIVATIVE. +! ------------------------------- + +!* 1.1 COMPUTE + +IF (LHOOK) CALL DR_HOOK('ESPNSDEAD_MOD:ESPNSDEAD',0,ZHOOK_HANDLE) +IF(KM == 0) THEN + ISKIP = 1 +ELSE + ISKIP = 1 +ENDIF + +DO JN=1,DALD%NCPL2M(KM),2 + + IN = (JN-1)/2 + ZIN = REAL(IN,JPRB)*GALD%EYWN + + DO J=1,2*KF_SCALARS,ISKIP + + PF(JN+1,J) = PF(JN+1,J)-ZIN*PNSD(JN ,J) + PF(JN ,J) = PF(JN ,J)+ZIN*PNSD(JN+1,J) + + ENDDO +ENDDO +IF (LHOOK) CALL DR_HOOK('ESPNSDEAD_MOD:ESPNSDEAD',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE ESPNSDEAD +END MODULE ESPNSDEAD_MOD diff --git a/src/etrans/etrans/internal/eupdsp_mod.F90 b/src/etrans/etrans/internal/eupdsp_mod.F90 new file mode 100644 index 000000000..210ac4fc5 --- /dev/null +++ b/src/etrans/etrans/internal/eupdsp_mod.F90 @@ -0,0 +1,141 @@ +MODULE EUPDSP_MOD +CONTAINS +SUBROUTINE EUPDSP(KM,KF_UV,KF_SCALARS,PFFT,PVODI, & + & PSPVOR,PSPDIV,PSPSCALAR,& + & PSPSC3A,PSPSC3B,PSPSC2 , & + & KFLDPTRUV,KFLDPTRSC) + +!**** *EUPDSP* - Update spectral arrays after direct Legendre transform + +! Purpose. +! -------- +! To update the spectral arrays for a fixed zonal wave-number +! from values in POA1 and POA2. + +!** Interface. +! ---------- +! CALL EUPDSP(...) + +! Explicit arguments : +! -------------------- +! KM - zonal wave-number +! POA1 - spectral fields for zonal wavenumber KM (basic var.) +! POA2 - spectral fields for zonal wavenumber KM (vor. div.) +! PSPVOR - spectral vorticity +! PSPDIV - spectral divergence +! PSPSCALAR - spectral scalar variables + +! Implicit arguments : +! -------------------- + +! Method. +! ------- + +! Externals. UPDSPB - basic transfer routine +! ---------- + +! Reference. +! ---------- +! ECMWF Research Department documentation of the IFS + +! Author. +! ------- +! Mats Hamrud and Philippe Courtier *ECMWF* + +! Modifications. +! -------------- +! Original : 88-02-02 +! Modified : 91-07-01 Philippe Courtier/Mats Hamrud - Rewrite +! for uv formulation +! Modified : 94-08-02 R. El Khatib - interface to UPDSPB +! M.Hamrud : 94-11-01 New conf 'G' - vor,div->vor,div +! instead of u,v->vor,div +! MPP Group: 95-10-01 Support for Distributed Memory version +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_TRANS ,ONLY : NF_SC2, NF_SC3A, NF_SC3B +!USE TPM_DISTR + +USE EUPDSPB_MOD ,ONLY : EUPDSPB +! + +IMPLICIT NONE + + +INTEGER(KIND=JPIM), INTENT(IN) :: KM,KF_UV,KF_SCALARS +REAL(KIND=JPRB) , INTENT(IN) :: PFFT(:,:) +REAL(KIND=JPRB) , INTENT(IN) :: PVODI(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPVOR(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPDIV(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PSPSCALAR(:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PSPSC2(:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PSPSC3A(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PSPSC3B(:,:,:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KFLDPTRUV(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KFLDPTRSC(:) + +INTEGER(KIND=JPIM) :: IVORS, IVORE, IDIVS, IDIVE, IST ,IEND,IDIM1,IDIM3,J3 +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +!* 1. UPDATE FIELDS +! ------------- + +!* 1.1 VORTICITY AND DIVERGENCE. + +IF (LHOOK) CALL DR_HOOK('EUPDSP_MOD:EUPDSP',0,ZHOOK_HANDLE) +IST = 1 +IF (KF_UV > 0) THEN + IST = IST+4*KF_UV + IVORS = 1 + IVORE = 2*KF_UV + IDIVS = 2*KF_UV+1 + IDIVE = 4*KF_UV + CALL EUPDSPB(KM,KF_UV,PVODI(:,IVORS:IVORE),PSPVOR,KFLDPTRUV) + CALL EUPDSPB(KM,KF_UV,PVODI(:,IDIVS:IDIVE),PSPDIV,KFLDPTRUV) +ENDIF + +!* 1.2 SCALARS + +IF (KF_SCALARS > 0) THEN + IF(PRESENT(PSPSCALAR)) THEN + IEND = IST+2*KF_SCALARS-1 + CALL EUPDSPB(KM,KF_SCALARS,PFFT(:,IST:IEND),PSPSCALAR,KFLDPTRSC) + ELSE + IF(PRESENT(PSPSC2) .AND. NF_SC2 > 0) THEN + IDIM1 = NF_SC2 + IEND = IST+2*IDIM1-1 + CALL EUPDSPB(KM,IDIM1,PFFT(:,IST:IEND),PSPSC2) + IST=IST+2*IDIM1 + ENDIF + IF(PRESENT(PSPSC3A) .AND. NF_SC3A > 0) THEN + IDIM1=NF_SC3A + IDIM3=UBOUND(PSPSC3A,3) + DO J3=1,IDIM3 + IEND = IST+2*IDIM1-1 + CALL EUPDSPB(KM,IDIM1,PFFT(:,IST:IEND),PSPSC3A(:,:,J3)) + IST=IST+2*IDIM1 + ENDDO + ENDIF + IF(PRESENT(PSPSC3B) .AND. NF_SC3B > 0) THEN + IDIM1=NF_SC3B + IDIM3=UBOUND(PSPSC3B,3) + DO J3=1,IDIM3 + IEND = IST+2*IDIM1-1 + CALL EUPDSPB(KM,IDIM1,PFFT(:,IST:IEND),PSPSC3B(:,:,J3)) + IST=IST+2*IDIM1 + ENDDO + ENDIF + ENDIF +ENDIF +IF (LHOOK) CALL DR_HOOK('EUPDSP_MOD:EUPDSP',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE EUPDSP +END MODULE EUPDSP_MOD diff --git a/src/etrans/etrans/internal/eupdspad_mod.F90 b/src/etrans/etrans/internal/eupdspad_mod.F90 new file mode 100644 index 000000000..8f1699a1a --- /dev/null +++ b/src/etrans/etrans/internal/eupdspad_mod.F90 @@ -0,0 +1,145 @@ +MODULE EUPDSPAD_MOD +CONTAINS +SUBROUTINE EUPDSPAD(KM,KF_UV,KF_SCALARS,PFFT,PVODI, & + & PSPVOR,PSPDIV,PSPSCALAR,& + & PSPSC3A,PSPSC3B,PSPSC2 , & + & KFLDPTRUV,KFLDPTRSC) + +!**** *EUPDSPAD* - Update spectral arrays after direct Legendre transform + +! Purpose. +! -------- +! To update the spectral arrays for a fixed zonal wave-number +! from values in POA1 and POA2. + +!** Interface. +! ---------- +! CALL EUPDSPAD(...) + +! Explicit arguments : +! -------------------- +! KM - zonal wave-number +! POA1 - spectral fields for zonal wavenumber KM (basic var.) +! POA2 - spectral fields for zonal wavenumber KM (vor. div.) +! PSPVOR - spectral vorticity +! PSPDIV - spectral divergence +! PSPSCALAR - spectral scalar variables + +! Implicit arguments : +! -------------------- + +! Method. +! ------- + +! Externals. UPDSPADB - basic transfer routine +! ---------- + +! Reference. +! ---------- +! ECMWF Research Department documentation of the IFS + +! Author. +! ------- +! Mats Hamrud and Philippe Courtier *ECMWF* + +! Modifications. +! -------------- +! Original : 88-02-02 +! Modified : 91-07-01 Philippe Courtier/Mats Hamrud - Rewrite +! for uv formulation +! Modified : 94-08-02 R. El Khatib - interface to UPDSPADB +! M.Hamrud : 94-11-01 New conf 'G' - vor,div->vor,div +! instead of u,v->vor,div +! MPP Group: 95-10-01 Support for Distributed Memory version +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +!USE TPM_DIM +USE TPM_TRANS ,ONLY : NF_SC2, NF_SC3A, NF_SC3B +!USE TPM_DISTR + +USE EUPDSPBAD_MOD ,ONLY : EUPDSPBAD +! + +IMPLICIT NONE + + +INTEGER(KIND=JPIM), INTENT(IN) :: KM,KF_UV,KF_SCALARS + +REAL(KIND=JPRB) , INTENT(OUT) :: PFFT(:,:) +REAL(KIND=JPRB) , INTENT(OUT) :: PVODI(:,:) + +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPVOR(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPDIV(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPSCALAR(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPSC2(:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPSC3A(:,:,:) +REAL(KIND=JPRB) ,OPTIONAL, INTENT(INOUT) :: PSPSC3B(:,:,:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KFLDPTRUV(:) +INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KFLDPTRSC(:) + +INTEGER(KIND=JPIM) :: IVORS, IVORE, IDIVS, IDIVE, IST ,IEND +INTEGER(KIND=JPIM) :: IDIM1,IDIM3,J3 +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +!* 1. UPDATE FIELDS +! ------------- + +!* 1.1 VORTICITY AND DIVERGENCE. + +IF (LHOOK) CALL DR_HOOK('EUPDSPAD_MOD:EUPDSPAD',0,ZHOOK_HANDLE) +IST = 1 +IF (KF_UV > 0) THEN + IST = IST+4*KF_UV + IVORS = 1 + IVORE = 2*KF_UV + IDIVS = 2*KF_UV+1 + IDIVE = 4*KF_UV + CALL EUPDSPBAD(KM,KF_UV,PVODI(:,IVORS:IVORE),PSPVOR,KFLDPTRUV) + CALL EUPDSPBAD(KM,KF_UV,PVODI(:,IDIVS:IDIVE),PSPDIV,KFLDPTRUV) +ENDIF + +!* 1.2 SCALARS + +IF (KF_SCALARS > 0) THEN + IF(PRESENT(PSPSCALAR)) THEN + IEND = IST+2*KF_SCALARS-1 + CALL EUPDSPBAD(KM,KF_SCALARS,PFFT(:,IST:IEND),PSPSCALAR,KFLDPTRSC) + ELSE + IF(PRESENT(PSPSC2) .AND. NF_SC2 > 0) THEN + IDIM1 = NF_SC2 + IEND = IST+2*IDIM1-1 + CALL EUPDSPBAD(KM,IDIM1,PFFT(:,IST:IEND),PSPSC2) + IST=IST+2*IDIM1 + ENDIF + IF(PRESENT(PSPSC3A) .AND. NF_SC3A > 0) THEN + IDIM1=NF_SC3A + IDIM3=UBOUND(PSPSC3A,3) + DO J3=1,IDIM3 + IEND = IST+2*IDIM1-1 + CALL EUPDSPBAD(KM,IDIM1,PFFT(:,IST:IEND),PSPSC3A(:,:,J3)) + IST=IST+2*IDIM1 + ENDDO + ENDIF + IF(PRESENT(PSPSC3B) .AND. NF_SC3B > 0) THEN + IDIM1=NF_SC3B + IDIM3=UBOUND(PSPSC3B,3) + DO J3=1,IDIM3 + IEND = IST+2*IDIM1-1 + CALL EUPDSPBAD(KM,IDIM1,PFFT(:,IST:IEND),PSPSC3B(:,:,J3)) + IST=IST+2*IDIM1 + ENDDO + ENDIF + ENDIF +ENDIF +IF (LHOOK) CALL DR_HOOK('EUPDSPAD_MOD:EUPDSPAD',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE EUPDSPAD +END MODULE EUPDSPAD_MOD diff --git a/src/etrans/etrans/internal/eupdspb_mod.F90 b/src/etrans/etrans/internal/eupdspb_mod.F90 new file mode 100644 index 000000000..37601c8f2 --- /dev/null +++ b/src/etrans/etrans/internal/eupdspb_mod.F90 @@ -0,0 +1,105 @@ +MODULE EUPDSPB_MOD +CONTAINS +SUBROUTINE EUPDSPB(KM,KFIELD,POA,PSPEC,KFLDPTR) + +!**** *EUPDSPB* - Update spectral arrays after direct Legendre transform + +! Purpose. +! -------- +! To update spectral arrays for a fixed zonal wave-number +! from values in POA. + +!** Interface. +! ---------- +! CALL EUPDSPB(....) + +! Explicit arguments : KM - zonal wavenumber +! -------------------- KFIELD - number of fields +! POA - work array +! PSPEC - spectral array + +! Implicit arguments : None +! -------------------- + +! Method. +! ------- + +! Externals. +! ---------- + +! Reference. +! ---------- +! ECMWF Research Department documentation of the IFS + +! Author. +! ------- +! Mats Hamrud and Philippe Courtier *ECMWF* + +! Modifications. +! -------------- +! Original : 88-02-02 +! D. Giard : 93-03-19 truncations NSMAX and NTMAX (see NOTE) +! R. El Khatib : 94-08-02 Replace number of fields by indexes of the +! first and last field +! L. Isaksen : 95-06-06 Reordering of spectral arrays +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +!USE TPM_DIM +!USE TPM_FIELDS +!USE TPM_DISTR +USE TPMALD_DISTR ,ONLY : DALD +! + +IMPLICIT NONE + +INTEGER(KIND=JPIM),INTENT(IN) :: KM,KFIELD +REAL(KIND=JPRB) ,INTENT(IN) :: POA(:,:) +REAL(KIND=JPRB) ,INTENT(OUT) :: PSPEC(:,:) +INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KFLDPTR(:) + +INTEGER(KIND=JPIM) :: II, INM, IR, JFLD, JN,IFLD +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +!* 1. UPDATE SPECTRAL FIELDS. +! ----------------------- +IF (LHOOK) CALL DR_HOOK('EUPDSPB_MOD:EUPDSPB',0,ZHOOK_HANDLE) +IF(PRESENT(KFLDPTR)) THEN + DO JN=1,DALD%NCPL2M(KM),2 + INM=DALD%NESM0(KM)+(JN-1)*2 + DO JFLD=1,KFIELD + IR= 2*JFLD-1 + II=IR+1 + IFLD = KFLDPTR(JFLD) + PSPEC(IFLD,INM) =POA(JN,IR) + PSPEC(IFLD,INM+1) =POA(JN+1,IR) + PSPEC(IFLD,INM+2) =POA(JN,II) + PSPEC(IFLD,INM+3) =POA(JN+1,II) + ENDDO + ENDDO +ELSE + DO JN=1,DALD%NCPL2M(KM),2 + INM=DALD%NESM0(KM)+(JN-1)*2 +! use unroll to provoke vectorization of outer loop +!cdir unroll=4 +!DIR$ IVDEP +!OCL NOVREC + DO JFLD=1,KFIELD + IR= 2*JFLD-1 + II=IR+1 + PSPEC(JFLD,INM) =POA(JN,IR) + PSPEC(JFLD,INM+1) =POA(JN+1,IR) + PSPEC(JFLD,INM+2) =POA(JN,II) + PSPEC(JFLD,INM+3) =POA(JN+1,II) + ENDDO + ENDDO +ENDIF +IF (LHOOK) CALL DR_HOOK('EUPDSPB_MOD:EUPDSPB',1,ZHOOK_HANDLE) + +END SUBROUTINE EUPDSPB +END MODULE EUPDSPB_MOD diff --git a/src/etrans/etrans/internal/eupdspbad_mod.F90 b/src/etrans/etrans/internal/eupdspbad_mod.F90 new file mode 100644 index 000000000..894f00260 --- /dev/null +++ b/src/etrans/etrans/internal/eupdspbad_mod.F90 @@ -0,0 +1,133 @@ +MODULE EUPDSPBAD_MOD +CONTAINS +SUBROUTINE EUPDSPBAD(KM,KFIELD,POA,PSPEC,KFLDPTR) + +!**** *EUPDSPBAD* - Update spectral arrays after direct Legendre transform + +! Purpose. +! -------- +! To update spectral arrays for a fixed zonal wave-number +! from values in POA. + +!** Interface. +! ---------- +! CALL EUPDSPBAD(....) + +! Explicit arguments : KM - zonal wavenumber +! -------------------- KFIELD - number of fields +! POA - work array +! PSPEC - spectral array + +! Implicit arguments : None +! -------------------- + +! Method. +! ------- + +! Externals. +! ---------- + +! Reference. +! ---------- +! ECMWF Research Department documentation of the IFS + +! Author. +! ------- +! Mats Hamrud and Philippe Courtier *ECMWF* + +! Modifications. +! -------------- +! Original : 88-02-02 +! D. Giard : 93-03-19 truncations NSMAX and NTMAX (see NOTE) +! R. El Khatib : 94-08-02 Replace number of fields by indexes of the +! first and last field +! L. Isaksen : 95-06-06 Reordering of spectral arrays +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +!USE TPM_DIM +!USE TPM_FIELDS +!USE TPM_DISTR + +USE TPMALD_DISTR ,ONLY : DALD +! + +IMPLICIT NONE + +INTEGER(KIND=JPIM),INTENT(IN) :: KM,KFIELD +REAL(KIND=JPRB) ,INTENT(OUT) :: POA(:,:) +REAL(KIND=JPRB) ,INTENT(INOUT) :: PSPEC(:,:) +INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KFLDPTR(:) + +INTEGER(KIND=JPIM) :: II, INM, IR, JFLD, JN,IFLD +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +!* 0. NOTE. +! ----- + +! The following transfer reads : +! SPEC(k,NASM0(m)+NLTN(n)*2) =POA(nn,2*k-1) (real part) +! SPEC(k,NASM0(m)+NLTN(n)*2+1)=POA(nn,2*k ) (imaginary part) +! with n from m to NSMAX +! and nn=NTMAX+2-n from NTMAX+2-m to NTMAX+2-NSMAX. +! NLTN(m)=NTMAX+2-m : n=NLTN(nn),nn=NLTN(n) +! nn is the loop index. + +! ------------------------------------------------------------------ + +IF (LHOOK) CALL DR_HOOK('EUPDSPBAD_MOD:EUPDSPBAD',0,ZHOOK_HANDLE) +POA(:,:) = 0.0_JPRB + +IF(PRESENT(KFLDPTR)) THEN + + DO JFLD=1,KFIELD + IR= 2*JFLD-1 + II=IR+1 + IFLD = KFLDPTR(JFLD) +!DIR$ IVDEP +!OCL NOVREC + DO JN=1,DALD%NCPL2M(KM),2 + INM=DALD%NESM0(KM)+(JN-1)*2 + POA(JN,IR) = PSPEC(IFLD,INM) + POA(JN+1,IR) = PSPEC(IFLD,INM+1) + POA(JN,II) = PSPEC(IFLD,INM+2) + POA(JN+1,II) = PSPEC(IFLD,INM+3) + PSPEC(IFLD,INM )= 0.0_JPRB + PSPEC(IFLD,INM+1)= 0.0_JPRB + PSPEC(IFLD,INM+2)= 0.0_JPRB + PSPEC(IFLD,INM+3)= 0.0_JPRB + ENDDO + ENDDO + +ELSE + + DO JN=1,DALD%NCPL2M(KM),2 + INM=DALD%NESM0(KM)+(JN-1)*2 +!DIR$ IVDEP +!OCL NOVREC + DO JFLD=1,KFIELD + IR= 2*JFLD-1 + II=IR+1 + POA(JN,IR) = PSPEC(JFLD,INM) + POA(JN+1,IR) = PSPEC(JFLD,INM+1) + POA(JN,II) = PSPEC(JFLD,INM+2) + POA(JN+1,II) = PSPEC(JFLD,INM+3) + PSPEC(JFLD,INM )= 0.0_JPRB + PSPEC(JFLD,INM+1)= 0.0_JPRB + PSPEC(JFLD,INM+2)= 0.0_JPRB + PSPEC(JFLD,INM+3)= 0.0_JPRB + ENDDO + ENDDO + +ENDIF +IF (LHOOK) CALL DR_HOOK('EUPDSPBAD_MOD:EUPDSPBAD',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE EUPDSPBAD +END MODULE EUPDSPBAD_MOD diff --git a/src/etrans/etrans/internal/euvtvd_comm_mod.F90 b/src/etrans/etrans/internal/euvtvd_comm_mod.F90 new file mode 100644 index 000000000..44fa1fe02 --- /dev/null +++ b/src/etrans/etrans/internal/euvtvd_comm_mod.F90 @@ -0,0 +1,127 @@ +MODULE EUVTVD_COMM_MOD +CONTAINS +SUBROUTINE EUVTVD_COMM(KFIELD,PSPMEANU,PSPMEANV,KFLDPTR) + +!**** *EUVTVD_COMM* - Communicate mean wind + +! Purpose. +! -------- + +!** Interface. +! ---------- +! CALL EUVTVD_COMM(KFIELD,PSPMEANU,PSPMEANV,KFLDPTR) + +! Explicit arguments : +! -------------------- KFIELD - number of fields (levels) +! KFLDPTR - fields pointers + +! Method. See ref. +! ------- + +! Externals. None. +! ---------- + +! Reference. +! ---------- +! ECMWF Research Department documentation of the IFS + +! Author. +! ------- +! Mats Hamrud and Philippe Courtier *ECMWF* + +! Modifications. +! -------------- +! Original : 91-07-01 +! D. Giard : NTMAX instead of NSMAX +! 01-08-27 : R. El Khatib Fix for NPROMATR /= 0 +! 03-03-03 : G. Radnoti: b-level conform mean-wind distribution +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! F. Vana + NEC 28-Apr-2009 MPI-OpenMP fix +! N. Lopes & R. El Khatib 15-Jun-2012 Scalability enhancement +! R. El Khatib 12-Jan-2020 Fix missing finalization of communications +! R. El Khatib 02-Jun-2022 Optimization/Cleaning +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_DIM +USE TPM_FIELDS +USE TPM_DISTR +USE TPMALD_GEO +USE TPMALD_DISTR +USE MPL_MODULE +USE SET2PE_MOD +USE ABORT_TRANS_MOD +IMPLICIT NONE + +INTEGER(KIND=JPIM), INTENT(IN) :: KFIELD +REAL(KIND=JPRB), INTENT(INOUT) :: PSPMEANU(KFIELD) +REAL(KIND=JPRB), INTENT(INOUT) :: PSPMEANV(KFIELD) +INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: KFLDPTR(KFIELD) + +INTEGER(KIND=JPIM) :: J, JA,ITAG,ILEN,IFLD,ISND, IM, JM + +INTEGER(KIND=JPIM) :: ISENDREQ(NPRTRW) + +REAL(KIND=JPRB) :: ZSPU(2*KFIELD) + +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +IF (LHOOK) CALL DR_HOOK('EUVTVD_COMM_MOD:EUVTVD_COMM',0,ZHOOK_HANDLE) + +!* 1. COMMUNICATE MEAN WIND +! --------------------- + +IF (D%NPROCM(0) == MYSETW) THEN + IF (PRESENT(KFLDPTR)) THEN + DO J=1,KFIELD + IFLD=KFLDPTR(J) + ZSPU(J)=PSPMEANU(IFLD) + ZSPU(KFIELD+J)=PSPMEANV(IFLD) + ENDDO + ELSE + DO J=1,KFIELD + ZSPU(J)=PSPMEANU(J) + ZSPU(KFIELD+J)=PSPMEANV(J) + ENDDO + ENDIF + DO JA=1,NPRTRW + IF (JA /= MYSETW) THEN + CALL SET2PE(ISND,0,0,JA,MYSETV) + ISND=NPRCIDS(ISND) + ITAG=1 + CALL MPL_SEND(ZSPU(1:2*KFIELD),KDEST=ISND,KTAG=ITAG, & + & KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=ISENDREQ(JA),CDSTRING='EUVTVD_COMM:') + ENDIF + ENDDO + DO JA=1,NPRTRW + IF (JA /= MYSETW) THEN + CALL MPL_WAIT(KREQUEST=ISENDREQ(JA),CDSTRING='EUVTVD_COMM:') + ENDIF + ENDDO +ELSE + CALL SET2PE(ISND,0,0,D%NPROCM(0),MYSETV) + ITAG=1 + CALL MPL_RECV(ZSPU(1:2*KFIELD),KSOURCE=NPRCIDS(ISND),KTAG=ITAG,KOUNT=ILEN, CDSTRING='EUVTVD_COMM:') + IF (ILEN /= 2*KFIELD) CALL ABORT_TRANS('EUVTVD_COMM: RECV INVALID RECEIVE MESSAGE LENGHT') + IF (PRESENT(KFLDPTR)) THEN + DO J=1,KFIELD + IFLD=KFLDPTR(J) + PSPMEANU(IFLD)=ZSPU(J) + PSPMEANV(IFLD)=ZSPU(KFIELD+J) + ENDDO + ELSE + DO J=1,KFIELD + PSPMEANU(J)=ZSPU(J) + PSPMEANV(J)=ZSPU(KFIELD+J) + ENDDO + ENDIF +ENDIF + +IF (LHOOK) CALL DR_HOOK('EUVTVD_COMM_MOD:EUVTVD_COMM',1,ZHOOK_HANDLE) + +END SUBROUTINE EUVTVD_COMM +END MODULE EUVTVD_COMM_MOD diff --git a/src/etrans/etrans/internal/euvtvd_mod.F90 b/src/etrans/etrans/internal/euvtvd_mod.F90 new file mode 100644 index 000000000..38d918d16 --- /dev/null +++ b/src/etrans/etrans/internal/euvtvd_mod.F90 @@ -0,0 +1,111 @@ +MODULE EUVTVD_MOD +CONTAINS +SUBROUTINE EUVTVD(KM,KMLOC,KFIELD,PU,PV,PVOR,PDIV) + +!**** *EUVTVD* - Compute vor/div from u and v in spectral space + +! Purpose. +! -------- +! To compute vorticity and divergence from u and v in spectral +! space. Input u and v from KM to NTMAX+1, output vorticity and +! divergence from KM to NTMAX - calculation part. + +!** Interface. +! ---------- +! CALL EUVTVD(KM,KFIELD,PEPSNM,PU,PV,PVOR,PDIV) + +! Explicit arguments : KM - zonal wave-number +! -------------------- KFIELD - number of fields (levels) +! PEPSNM - REPSNM for wavenumber KM +! PU - u wind component for zonal +! wavenumber KM +! PV - v wind component for zonal +! wavenumber KM +! PVOR - vorticity for zonal +! wavenumber KM +! PDIV - divergence for zonal +! wavenumber KM + +! Method. See ref. +! ------- + +! Externals. None. +! ---------- + +! Reference. +! ---------- +! ECMWF Research Department documentation of the IFS + +! Author. +! ------- +! Mats Hamrud and Philippe Courtier *ECMWF* + +! Modifications. +! -------------- +! Original : 91-07-01 +! D. Giard : NTMAX instead of NSMAX +! 01-08-27 : R. El Khatib Fix for NPROMATR /= 0 +! 03-03-03 : G. Radnoti: b-level conform mean-wind distribution +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! F. Vana + NEC 28-Apr-2009 MPI-OpenMP fix +! D. Degrauwe (Feb 2012): Alternative extension zone (E') +! N. Lopes & R. El Khatib 15-Jun-2012 Scalability enhancement +! R. El Khatib 02-Jun-2022 Optimization/Cleaning +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_DIM ,ONLY : R +USE TPMALD_GEO ,ONLY : GALD +USE TPMALD_DISTR ,ONLY : DALD + +IMPLICIT NONE + +INTEGER(KIND=JPIM), INTENT(IN) :: KM +INTEGER(KIND=JPIM), INTENT(IN) :: KMLOC +INTEGER(KIND=JPIM), INTENT(IN) :: KFIELD +REAL(KIND=JPRB), INTENT(IN) :: PU(:,:) +REAL(KIND=JPRB), INTENT(IN) :: PV(:,:) +REAL(KIND=JPRB), INTENT(OUT):: PVOR(:,:) +REAL(KIND=JPRB), INTENT(OUT):: PDIV(:,:) + +INTEGER(KIND=JPIM) :: II, IN, IR, J, JN + +REAL(KIND=JPRB) :: ZKM, ZIN + +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +IF (LHOOK) CALL DR_HOOK('EUVTVD_MOD:EUVTVD',0,ZHOOK_HANDLE) + +!* 1. COMPUTE U V FROM VORTICITY AND DIVERGENCE. +! ------------------------------------------ + +ZKM=REAL(KM,JPRB)*GALD%EXWN +DO J=1,KFIELD + IR=2*J-1 + II=IR+1 + DO JN=1,R%NDGL+R%NNOEXTZG + PDIV(JN,IR)=-ZKM*PU(JN,II) + PDIV(JN,II)= ZKM*PU(JN,IR) + PVOR(JN,IR)=-ZKM*PV(JN,II) + PVOR(JN,II)= ZKM*PV(JN,IR) + ENDDO +ENDDO +DO J=1,2*KFIELD + DO JN=1,DALD%NCPL2M(KM),2 + IN=(JN-1)/2 + ZIN=REAL(IN,JPRB)*GALD%EYWN + PVOR(JN,J )=PVOR(JN ,J)+ZIN*PU(JN+1,J) + PVOR(JN+1,J)=PVOR(JN+1,J)-ZIN*PU(JN ,J) + PDIV(JN,J )=PDIV(JN ,J)-ZIN*PV(JN+1,J) + PDIV(JN+1,J)=PDIV(JN+1,J)+ZIN*PV(JN ,J) + ENDDO +ENDDO + +IF (LHOOK) CALL DR_HOOK('EUVTVD_MOD:EUVTVD',1,ZHOOK_HANDLE) + +END SUBROUTINE EUVTVD +END MODULE EUVTVD_MOD diff --git a/src/etrans/etrans/internal/euvtvdad_mod.F90 b/src/etrans/etrans/internal/euvtvdad_mod.F90 new file mode 100644 index 000000000..8b72f9932 --- /dev/null +++ b/src/etrans/etrans/internal/euvtvdad_mod.F90 @@ -0,0 +1,128 @@ +MODULE EUVTVDAD_MOD +CONTAINS +SUBROUTINE EUVTVDAD(KM,KMLOC,KFIELD,KFLDPTR,PU,PV,PVOR,PDIV,PSPMEANU,PSPMEANV) + +!**** *EUVTVDAD* - Compute vor/div from u and v in spectral space + +! Purpose. +! -------- +! To compute vorticity and divergence from u and v in spectral +! space. Input u and v from KM to NTMAX+1, output vorticity and +! divergence from KM to NTMAX. + +!** Interface. +! ---------- +! CALL EUVTVDAD() + +! Explicit arguments : KM - zonal wave-number +! -------------------- KFIELD - number of fields (levels) +! KFLDPTR - fields pointers +! PEPSNM - REPSNM for wavenumber KM +! PU - u wind component for zonal +! wavenumber KM +! PV - v wind component for zonal +! wavenumber KM +! PVOR - vorticity for zonal +! wavenumber KM +! PDIV - divergence for zonal +! wavenumber KM + +! Method. See ref. +! ------- + +! Externals. None. +! ---------- + +! Reference. +! ---------- +! ECMWF Research Department documentation of the IFS + +! Author. +! ------- +! Mats Hamrud and Philippe Courtier *ECMWF* + +! Modifications. +! -------------- +! Original : 91-07-01 +! D. Giard : NTMAX instead of NSMAX +! 01-08-27 : R. El Khatib Fix for NPROMATR /= 0 +! 03-03-03 G. Radnoti: b-level conform mean wind distribution +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! 01-Dec-2004 A. Deckmyn removed erasing of mean wind +! D. Degrauwe (Feb 2012): Alternative extension zone (E') +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_DIM ,ONLY : R +!USE TPM_FIELDS + +USE TPMALD_GEO ,ONLY : GALD +USE TPMALD_DISTR ,ONLY : DALD +! + +IMPLICIT NONE + +INTEGER(KIND=JPIM), INTENT(IN) :: KFIELD, KM, KMLOC +REAL(KIND=JPRB), INTENT(IN) :: PVOR(:,:),PDIV(:,:) +REAL(KIND=JPRB), INTENT(INOUT) :: PU (:,:),PV (:,:) + +INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: KFLDPTR(:) +REAL(KIND=JPRB), OPTIONAL, INTENT(INOUT) :: PSPMEANU(:),PSPMEANV(:) + +INTEGER(KIND=JPIM) :: II, IN, IR, J, JN, IFLD + +REAL(KIND=JPRB) :: ZKM +REAL(KIND=JPRB) :: ZIN +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +IF (LHOOK) CALL DR_HOOK('EUVTVDAD_MOD:EUVTVDAD',0,ZHOOK_HANDLE) + +IF (KM == 0) THEN + IF (PRESENT(KFLDPTR)) THEN + DO J=1,KFIELD + IR=2*J-1 + IFLD=KFLDPTR(J) + PU(1,IR)=PSPMEANU(IFLD) + PV(1,IR)=PSPMEANV(IFLD) + ENDDO + ELSE + DO J=1,KFIELD + IR=2*J-1 + PU(1,IR)=PSPMEANU(J) + PV(1,IR)=PSPMEANV(J) + ENDDO + ENDIF +ENDIF + +DO J=1,2*KFIELD + DO JN=1,DALD%NCPL2M(KM),2 + IN=(JN-1)/2 + ZIN=REAL(IN,JPRB)*GALD%EYWN + PU(JN+1,J) = PU(JN+1,J) + ZIN * PVOR(JN ,J) + PU(JN ,J) = PU(JN ,J) - ZIN * PVOR(JN+1,J) + PV(JN+1,J) = PV(JN+1,J) - ZIN * PDIV(JN ,J) + PV(JN ,J) = PV(JN ,J) + ZIN * PDIV(JN+1,J) + ENDDO +ENDDO + +ZKM=REAL(KM,JPRB)*GALD%EXWN +DO J=1,KFIELD + IR=2*J-1 + II=IR+1 + DO JN=1,R%NDGL+R%NNOEXTZG + PU(JN,II) = PU(JN,II) - ZKM * PDIV(JN,IR) + PU(JN,IR) = PU(JN,IR) + ZKM * PDIV(JN,II) + PV(JN,II) = PV(JN,II) - ZKM * PVOR(JN,IR) + PV(JN,IR) = PV(JN,IR) + ZKM * PVOR(JN,II) + ENDDO +ENDDO +IF (LHOOK) CALL DR_HOOK('EUVTVDAD_MOD:EUVTVDAD',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE EUVTVDAD +END MODULE EUVTVDAD_MOD diff --git a/src/etrans/etrans/internal/evdtuv_mod.F90 b/src/etrans/etrans/internal/evdtuv_mod.F90 new file mode 100644 index 000000000..33f9f4e8b --- /dev/null +++ b/src/etrans/etrans/internal/evdtuv_mod.F90 @@ -0,0 +1,125 @@ +MODULE EVDTUV_MOD +CONTAINS +SUBROUTINE EVDTUV(KM,KFIELD,KFLDPTR,PVOR,PDIV,PU,PV,PSPMEANU,PSPMEANV) + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +!USE TPM_DIM +!USE TPM_FIELDS +USE TPMALD_FIELDS ,ONLY : FALD +USE TPMALD_GEO ,ONLY : GALD +USE TPMALD_DISTR ,ONLY : DALD + +!**** *VDTUV* - Compute U,V in spectral space + +! Purpose. +! -------- +! In Laplace space compute the the winds +! from vorticity and divergence. + +!** Interface. +! ---------- +! CALL VDTUV(...) + +! Explicit arguments : KM -zonal wavenumber (input-c) +! -------------------- KFIELD - number of fields (input-c) +! KFLDPTR - fields pointers +! PEPSNM - REPSNM for wavenumber KM (input-c) +! PVOR(NLEI1,2*KFIELD) - vorticity (input) +! PDIV(NLEI1,2*KFIELD) - divergence (input) +! PU(NLEI1,2*KFIELD) - u wind (output) +! PV(NLEI1,2*KFIELD) - v wind (output) +! Organisation within NLEI1: +! NLEI1 = NSMAX+4+mod(NSMAX+4+1,2) +! overdimensioning +! 1 : n=NSMAX+2 +! 2 : n=NSMAX+1 +! 3 : n=NSMAX +! . : +! . : +! NSMAX+3 : n=0 +! NSMAX+4 : n=-1 + +! Implicit arguments : Eigenvalues of inverse Laplace operator +! -------------------- from YOMLAP + +! Method. +! ------- + +! Externals. None. +! ---------- + +! Reference. +! ---------- +! ECMWF Research Department documentation of the IFS +! Temperton, 1991, MWR 119 p1303 + +! Author. +! ------- +! Mats Hamrud and Philippe Courtier *ECMWF* + +! Modifications. +! -------------- +! Original : 00-02-01 From VDTUV in IFS CY22R1 +! 01-08-27 : R. El Khatib Fix for NPROMATR /= 0 +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! ------------------------------------------------------------------ + +IMPLICIT NONE + +INTEGER(KIND=JPIM), INTENT(IN) :: KM, KFIELD +REAL(KIND=JPRB), INTENT(IN) :: PVOR(:,:),PDIV(:,:) +REAL(KIND=JPRB), INTENT(OUT) :: PU (:,:),PV (:,:) + +INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: KFLDPTR(:) +REAL(KIND=JPRB), OPTIONAL, INTENT(IN) :: PSPMEANU(:),PSPMEANV(:) + +INTEGER(KIND=JPIM) :: II, IJ, IR, J, JN, IN, IFLD + +REAL(KIND=JPRB) :: ZKM +REAL(KIND=JPRB) :: ZIN +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE +IF (LHOOK) CALL DR_HOOK('EVDTUV_MOD:EVDTUV',0,ZHOOK_HANDLE) +ZKM=REAL(KM,JPRB)*GALD%EXWN +DO J=1,2*KFIELD + DO JN=1,DALD%NCPL2M(KM),2 + IN = (JN-1)/2 + ZIN = REAL(IN,JPRB)*GALD%EYWN + PU(JN ,J) = -ZIN*PVOR(JN+1,J) + PU(JN+1,J) = ZIN*PVOR(JN,J) + PV(JN ,J) = -ZIN*PDIV(JN+1,J) + PV(JN+1,J) = ZIN*PDIV(JN,J) + ENDDO +ENDDO +DO J=1,KFIELD + IR = 2*J-1 + II = IR+1 + DO JN=1,DALD%NCPL2M(KM) + IJ=(JN-1)/2 + PU(JN,IR)= FALD%RLEPINM(DALD%NPME(KM)+IJ)*(-ZKM*PDIV(JN,II)-PU(JN,IR)) + PU(JN,II)= FALD%RLEPINM(DALD%NPME(KM)+IJ)*( ZKM*PDIV(JN,IR)-PU(JN,II)) + PV(JN,IR)= FALD%RLEPINM(DALD%NPME(KM)+IJ)*(-ZKM*PVOR(JN,II)+PV(JN,IR)) + PV(JN,II)= FALD%RLEPINM(DALD%NPME(KM)+IJ)*( ZKM*PVOR(JN,IR)+PV(JN,II)) + ENDDO +ENDDO +IF (KM == 0) THEN + IF (PRESENT(KFLDPTR)) THEN + DO J = 1, KFIELD + IR = 2*J-1 + IFLD=KFLDPTR(J) + PU(1,IR)=PSPMEANU(IFLD) + PV(1,IR)=PSPMEANV(IFLD) + ENDDO + ELSE + DO J = 1, KFIELD + IR = 2*J-1 + PU(1,IR)=PSPMEANU(J) + PV(1,IR)=PSPMEANV(J) + ENDDO + ENDIF +ENDIF +IF (LHOOK) CALL DR_HOOK('EVDTUV_MOD:EVDTUV',1,ZHOOK_HANDLE) + +END SUBROUTINE EVDTUV +END MODULE EVDTUV_MOD diff --git a/src/etrans/etrans/internal/evdtuvad_comm_mod.F90 b/src/etrans/etrans/internal/evdtuvad_comm_mod.F90 new file mode 100644 index 000000000..492a01bbc --- /dev/null +++ b/src/etrans/etrans/internal/evdtuvad_comm_mod.F90 @@ -0,0 +1,163 @@ +MODULE EVDTUVAD_COMM_MOD +CONTAINS +SUBROUTINE EVDTUVAD_COMM(KM,KMLOC,KFIELD,KFLDPTR,PSPMEANU,PSPMEANV) + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_DIM +USE TPM_FIELDS +USE TPM_DISTR + +USE TPMALD_FIELDS +USE TPMALD_GEO +USE TPMALD_DISTR + +USE MPL_MODULE +USE ABORT_TRANS_MOD +USE SET2PE_MOD + + +!**** *EVDTUVAD_COMM* - Compute U,V in spectral space + +! Purpose. +! -------- +! In Laplace space communicate the mean winds +! from vorticity and divergence. + +!** Interface. +! ---------- +! CALL EVDTUVAD_COMM(...) + +! Explicit arguments : KM -zonal wavenumber (input-c) +! -------------------- KFIELD - number of fields (input-c) +! KFLDPTR - fields pointers +! PEPSNM - REPSNM for wavenumber KM (input-c) +! Organisation within NLEI1: +! NLEI1 = NSMAX+4+mod(NSMAX+4+1,2) +! overdimensioning +! 1 : n=NSMAX+2 +! 2 : n=NSMAX+1 +! 3 : n=NSMAX +! . : +! . : +! NSMAX+3 : n=0 +! NSMAX+4 : n=-1 + +! Implicit arguments : Eigenvalues of inverse Laplace operator +! -------------------- from YOMLAP + +! Method. +! ------- + +! Externals. None. +! ---------- + +! Reference. +! ---------- +! ECMWF Research Department documentation of the IFS +! Temperton, 1991, MWR 119 p1303 + +! Author. +! ------- +! Mats Hamrud and Philippe Courtier *ECMWF* + +! Modifications. +! -------------- +! Original : 00-02-01 From VDTUVAD in IFS CY22R1 +! 01-08-27 : R. El Khatib Fix for NPROMATR /= 0 +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! 01-Dec-2004 A. Deckmyn Fix mean wind for NPRTRW > 1 +! N. Lopes & R. El Khatib 15-Jun-2012 Scalability enhancement + +! thread-safety +! R. El Khatib 12-Jan-2020 Fix missing finalization of communications +! R. El Khatib 02-Jun-2022 Optimization/Cleaning +! ------------------------------------------------------------------ + +IMPLICIT NONE + +INTEGER(KIND=JPIM), INTENT(IN) :: KM, KFIELD, KMLOC + +INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: KFLDPTR(:) +REAL(KIND=JPRB), OPTIONAL, INTENT(OUT) :: PSPMEANU(:),PSPMEANV(:) + +INTEGER(KIND=JPIM) :: II, IJ, IR, J, JN, IFLD + +INTEGER(KIND=JPIM) :: IN +INTEGER(KIND=JPIM) :: ISND, JA, ITAG, ILEN + +INTEGER(KIND=JPIM) :: ISENDREQ(NPRTRW) + +REAL(KIND=JPRB) :: ZSPU(2*KFIELD) +REAL(KIND=JPRB) :: ZKM +REAL(KIND=JPRB) :: ZIN +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +IF (LHOOK) CALL DR_HOOK('EVDTUVAD_COMM_MOD:EVDTUVAD_COMM',0,ZHOOK_HANDLE) + +IF (NPRTRW > 1 .AND. KFIELD > 0) THEN + IF (KM == 0) THEN + IF (PRESENT(KFLDPTR)) THEN + DO J=1,KFIELD + IFLD=KFLDPTR(J) + ZSPU(J)=PSPMEANU(IFLD) + ZSPU(KFIELD+J)=PSPMEANV(IFLD) + ENDDO + ELSE + DO J=1,KFIELD + ZSPU(J)=PSPMEANU(J) + ZSPU(KFIELD+J)=PSPMEANV(J) + ENDDO + ENDIF + DO JA=1,NPRTRW + IF (JA /= MYSETW) THEN + CALL SET2PE(ISND,0,0,JA,MYSETV) + ISND=NPRCIDS(ISND) + ITAG=300000+KFIELD*NPROC+ISND + CALL MPL_SEND(ZSPU(1:2*KFIELD),KDEST=ISND,KTAG=ITAG, & + & KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=ISENDREQ(JA), & + & CDSTRING='EVDTUVAD_COMM:') + ENDIF + ENDDO + ELSE + IF (KMLOC == 1) THEN + IF (D%NPROCM(0) /= MYSETW) THEN + CALL SET2PE(ISND,0,0,D%NPROCM(0),MYSETV) + ISND=NPRCIDS(ISND) + ITAG=300000+KFIELD*NPROC+MYPROC + CALL MPL_RECV(ZSPU(1:2*KFIELD),KSOURCE=ISND,KTAG=ITAG,KOUNT=ILEN,CDSTRING='EVDTUVAD_COMM:') + IF (ILEN /= 2*KFIELD) THEN + CALL ABORT_TRANS('EVDTUVAD_COMM: RECV INVALID RECEIVE MESSAGE LENGTH') + ENDIF + IF (PRESENT(KFLDPTR)) THEN + DO J=1,KFIELD + IFLD=KFLDPTR(J) + PSPMEANU(IFLD)=ZSPU(J) + PSPMEANV(IFLD)=ZSPU(KFIELD+J) + ENDDO + ELSE + DO J=1,KFIELD + PSPMEANU(J)=ZSPU(J) + PSPMEANV(J)=ZSPU(KFIELD+J) + ENDDO + ENDIF + ENDIF + ENDIF + ENDIF + IF (KM == 0) THEN + DO JA=1,NPRTRW + IF (JA /= MYSETW) THEN + CALL MPL_WAIT(KREQUEST=ISENDREQ(JA),CDSTRING='EUVTVDAD_COMM:') + ENDIF + ENDDO + ENDIF +ENDIF + +IF (LHOOK) CALL DR_HOOK('EVDTUVAD_COMM_MOD:EVDTUVAD_COMM',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE EVDTUVAD_COMM +END MODULE EVDTUVAD_COMM_MOD diff --git a/src/etrans/etrans/internal/evdtuvad_mod.F90 b/src/etrans/etrans/internal/evdtuvad_mod.F90 new file mode 100644 index 000000000..a34135fcb --- /dev/null +++ b/src/etrans/etrans/internal/evdtuvad_mod.F90 @@ -0,0 +1,151 @@ +MODULE EVDTUVAD_MOD +CONTAINS +SUBROUTINE EVDTUVAD(KM,KMLOC,KFIELD,KFLDPTR,PVOR,PDIV,PU,PV,PSPMEANU,PSPMEANV) + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +!USE TPM_DIM +!USE TPM_FIELDS +USE TPM_DISTR ,ONLY : D, NPRCIDS, NPRTRW, MYSETV, MYSETW, MYPROC, NPROC + +USE TPMALD_FIELDS ,ONLY : FALD +USE TPMALD_GEO ,ONLY : GALD +USE TPMALD_DISTR ,ONLY : DALD + +!**** *EVDTUVAD* - Compute U,V in spectral space + +! Purpose. +! -------- +! In Laplace space compute the the winds +! from vorticity and divergence. + +!** Interface. +! ---------- +! CALL EVDTUVAD(...) + +! Explicit arguments : KM -zonal wavenumber (input-c) +! -------------------- KFIELD - number of fields (input-c) +! KFLDPTR - fields pointers +! PEPSNM - REPSNM for wavenumber KM (input-c) +! PVOR(NLEI1,2*KFIELD) - vorticity (input) +! PDIV(NLEI1,2*KFIELD) - divergence (input) +! PU(NLEI1,2*KFIELD) - u wind (output) +! PV(NLEI1,2*KFIELD) - v wind (output) +! Organisation within NLEI1: +! NLEI1 = NSMAX+4+mod(NSMAX+4+1,2) +! overdimensioning +! 1 : n=NSMAX+2 +! 2 : n=NSMAX+1 +! 3 : n=NSMAX +! . : +! . : +! NSMAX+3 : n=0 +! NSMAX+4 : n=-1 + +! Implicit arguments : Eigenvalues of inverse Laplace operator +! -------------------- from YOMLAP + +! Method. +! ------- + +! Externals. None. +! ---------- + +! Reference. +! ---------- +! ECMWF Research Department documentation of the IFS +! Temperton, 1991, MWR 119 p1303 + +! Author. +! ------- +! Mats Hamrud and Philippe Courtier *ECMWF* + +! Modifications. +! -------------- +! Original : 00-02-01 From VDTUVAD in IFS CY22R1 +! 01-08-27 : R. El Khatib Fix for NPROMATR /= 0 +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! 01-Dec-2004 A. Deckmyn Fix mean wind for NPRTRW > 1 +! N. Lopes & R. El Khatib 15-Jun-2012 Scalability enhancement + +! thread-safety +! ------------------------------------------------------------------ + +IMPLICIT NONE + +INTEGER(KIND=JPIM), INTENT(IN) :: KM, KFIELD, KMLOC +REAL(KIND=JPRB), INTENT(INOUT) :: PVOR(:,:),PDIV(:,:) +REAL(KIND=JPRB), INTENT(INOUT) :: PU (:,:),PV (:,:) + +INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: KFLDPTR(:) +REAL(KIND=JPRB), OPTIONAL, INTENT(OUT) :: PSPMEANU(:),PSPMEANV(:) + +INTEGER(KIND=JPIM) :: II, IJ, IR, J, JN, IFLD + +INTEGER(KIND=JPIM) :: IN +INTEGER(KIND=JPIM) :: ISND, JA, ITAG, ILEN + +REAL(KIND=JPRB) :: ZSPU(2*KFIELD) +REAL(KIND=JPRB) :: ZKM +REAL(KIND=JPRB) :: ZIN +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +IF (LHOOK) CALL DR_HOOK('EVDTUVAD_MOD:EVDTUVAD',0,ZHOOK_HANDLE) + +IF (KM == 0) THEN + IF (PRESENT(KFLDPTR)) THEN + DO J = 1, KFIELD + IR = 2*J-1 + IFLD=KFLDPTR(J) + PSPMEANU(IFLD)=PU(1,IR) + PSPMEANV(IFLD)=PV(1,IR) + ENDDO + ELSE + DO J = 1, KFIELD + IR = 2*J-1 + PSPMEANU(J)=PU(1,IR) + PSPMEANV(J)=PV(1,IR) + ENDDO + ENDIF +ENDIF + +ZKM=REAL(KM,JPRB)*GALD%EXWN +DO J=1,KFIELD + IR = 2*J-1 + II = IR+1 + DO JN=1,DALD%NCPL2M(KM) + IJ=(JN-1)/2 + PDIV(JN,II)=PDIV(JN,II)-ZKM*FALD%RLEPINM(DALD%NPME(KM)+IJ)*PU(JN,IR) + PU(JN,IR)=-FALD%RLEPINM(DALD%NPME(KM)+IJ)*PU(JN,IR) + + PDIV(JN,IR)=PDIV(JN,IR)+ZKM*FALD%RLEPINM(DALD%NPME(KM)+IJ)*PU(JN,II) + PU(JN,II)=-FALD%RLEPINM(DALD%NPME(KM)+IJ)*PU(JN,II) + + PVOR(JN,II)=PVOR(JN,II)-ZKM*FALD%RLEPINM(DALD%NPME(KM)+IJ)*PV(JN,IR) + PV(JN,IR)=FALD%RLEPINM(DALD%NPME(KM)+IJ)*PV(JN,IR) + + PVOR(JN,IR)=PVOR(JN,IR)+ZKM*FALD%RLEPINM(DALD%NPME(KM)+IJ)*PV(JN,II) + PV(JN,II)=FALD%RLEPINM(DALD%NPME(KM)+IJ)*PV(JN,II) + + ENDDO +ENDDO + +DO J=1,2*KFIELD + DO JN=1,DALD%NCPL2M(KM),2 + IN = (JN-1)/2 + ZIN = REAL(IN,JPRB)*GALD%EYWN + PVOR(JN+1,J) = PVOR(JN+1,J)-ZIN*PU(JN ,J) + PVOR(JN ,J) = PVOR(JN ,J)+ZIN*PU(JN+1,J) + PDIV(JN+1,J) = PDIV(JN+1,J)-ZIN*PV(JN ,J) + PDIV(JN ,J) = PDIV(JN ,J)+ZIN*PV(JN+1,J) + ENDDO +ENDDO + +IF (LHOOK) CALL DR_HOOK('EVDTUVAD_MOD:EVDTUVAD',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE EVDTUVAD +END MODULE EVDTUVAD_MOD diff --git a/src/etrans/etrans/internal/suefft_mod.F90 b/src/etrans/etrans/internal/suefft_mod.F90 new file mode 100644 index 000000000..96d48790f --- /dev/null +++ b/src/etrans/etrans/internal/suefft_mod.F90 @@ -0,0 +1,114 @@ +MODULE SUEFFT_MOD +CONTAINS +SUBROUTINE SUEFFT + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_DIM ,ONLY : R +USE TPM_GEN ,ONLY : NOUT, NPRINTLEV +USE TPM_DISTR ,ONLY : D, MYSETW +USE TPM_GEOMETRY ,ONLY : G +USE TPM_FFT ,ONLY : T, TB +#ifdef WITH_FFTW +USE TPM_FFTW ,ONLY : TW, INIT_PLANS_FFTW +#endif +USE BLUESTEIN_MOD ,ONLY : BLUESTEIN_INIT, FFTB_TYPE +! + +USE TPMALD_FFT ,ONLY : TALD +! + +IMPLICIT NONE + +INTEGER(KIND=JPIM) :: JGL,IGLG, ILATS +LOGICAL :: LLP1,LLP2 +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +IF (LHOOK) CALL DR_HOOK('SUEFFT_MOD:SUEFFT',0,ZHOOK_HANDLE) + +IF(.NOT.D%LGRIDONLY) THEN + + LLP1 = NPRINTLEV>0 + LLP2 = NPRINTLEV>1 + IF(LLP1) WRITE(NOUT,*) '=== ENTER ROUTINE SUEFFT ===' + +#ifdef WITH_FFTW + IF(TW%LFFTW)THEN + + CALL INIT_PLANS_FFTW(MAX(R%NDLON+R%NNOEXTZL,R%NDGL+R%NNOEXTZG)) + + ELSE + + NULLIFY(TW%FFTW_PLANS) +#endif + + ALLOCATE(T%TRIGS(R%NDLON+R%NNOEXTZL,D%NDGL_FS)) + IF(LLP2)WRITE(NOUT,9) 'T%TRIGS ',SIZE(T%TRIGS),SHAPE(T%TRIGS) + ALLOCATE(T%NFAX(19,D%NDGL_FS)) + IF(LLP2)WRITE(NOUT,9) 'T%NFAX ',SIZE(T%NFAX),SHAPE(T%NFAX) + ALLOCATE(T%LUSEFFT992(D%NDGL_FS)) + IF(LLP2)WRITE(NOUT,9) 'T%LUSEFFT992',SIZE(T%LUSEFFT992),SHAPE(T%LUSEFFT992) + + ! + ! create TRIGS and NFAX for latitude lengths supported by FFT992, + ! that is just with factors 2, 3 or 5 + ! + + T%LBLUESTEIN=.FALSE. + ILATS=0 + DO JGL=1,D%NDGL_FS + IGLG = D%NPTRLS(MYSETW)+JGL-1 + IF (G%NLOEN(IGLG)>1) THEN + CALL SET99B(T%TRIGS(1,JGL),T%NFAX(1,JGL),G%NLOEN(IGLG)+R%NNOEXTZL,T%LUSEFFT992(JGL)) + IF( .NOT.T%LUSEFFT992(JGL) )THEN + ILATS=ILATS+1 + T%LBLUESTEIN=.TRUE. + ENDIF + ENDIF + ENDDO + + ! + ! we only initialise for bluestein if there are latitude lengths + ! not supported by FFT992 + ! + + IF( T%LBLUESTEIN )THEN + TB%NDLON=R%NDLON + TB%NLAT_COUNT=ILATS + ILATS=0 + ALLOCATE(TB%NLATS(TB%NLAT_COUNT)) + DO JGL=1,D%NDGL_FS + IF( .NOT.T%LUSEFFT992(JGL) )THEN + ILATS=ILATS+1 + TB%NLATS(ILATS)=R%NDLON+R%NNOEXTZL + ENDIF + ENDDO + CALL BLUESTEIN_INIT(TB) + ENDIF + +#ifdef WITH_FFTW + + ENDIF +#endif + + IF(TALD%LFFT992)THEN + ALLOCATE(TALD%TRIGSE(R%NDGL+R%NNOEXTZG)) + IF(LLP2)WRITE(NOUT,9) 'TALD%TRIGSE ',SIZE(TALD%TRIGSE),SHAPE(TALD%TRIGSE) + ALLOCATE(TALD%NFAXE(19)) + IF(LLP2)WRITE(NOUT,9) 'TALD%NFAXE ',SIZE(TALD%NFAXE),SHAPE(TALD%NFAXE) + CALL SET99(TALD%TRIGSE,TALD%NFAXE,R%NDGL+R%NNOEXTZG) + ENDIF + +ENDIF + +IF (LHOOK) CALL DR_HOOK('SUEFFT_MOD:SUEFFT',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +9 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8) + +END SUBROUTINE SUEFFT +END MODULE SUEFFT_MOD diff --git a/src/etrans/etrans/internal/suemp_trans_mod.F90 b/src/etrans/etrans/internal/suemp_trans_mod.F90 new file mode 100644 index 000000000..ae689f5e1 --- /dev/null +++ b/src/etrans/etrans/internal/suemp_trans_mod.F90 @@ -0,0 +1,267 @@ +MODULE SUEMP_TRANS_MOD +CONTAINS +SUBROUTINE SUEMP_TRANS + +! Set up distributed environment for the transform package (part 2) +! R. El Khatib 09-Aug-2013 Allow LEQ_REGIONS + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_GEN ,ONLY : NOUT, NPRINTLEV +USE TPM_DIM ,ONLY : R +USE TPM_GEOMETRY ,ONLY : G +USE TPM_DISTR ,ONLY : D, LEQ_REGIONS, NPRTRNS, NPRTRV, NPRTRW, MYSETW, NPROC, MYPROC +USE TPMALD_DIM ,ONLY : RALD +!USE TPMALD_DISTR +!USE SUWAVEDI_MOD +!USE PE2SET_MOD +USE SUMPLATF_MOD ,ONLY : SUMPLATF +USE SUEMPLAT_MOD ,ONLY : SUEMPLAT +USE SUESTAONL_MOD ,ONLY : SUESTAONL +USE MYSENDSET_MOD ,ONLY : MYSENDSET +USE MYRECVSET_MOD ,ONLY : MYRECVSET +USE EQ_REGIONS_MOD ,ONLY : MY_REGION_EW, MY_REGION_NS, & + & N_REGIONS, N_REGIONS_EW, N_REGIONS_NS +! + +IMPLICIT NONE + +INTEGER(KIND=JPIM) :: JM,JMLOC +INTEGER(KIND=JPIM) :: JGL,IGL,IPLAT,ISENDSET,IRECVSET,JML,IPOS,IM +INTEGER(KIND=JPIM) :: I1,I2,I3,IAUX0,IAUX1,JA1 +INTEGER(KIND=JPIM) :: IGPTOT,IMEDIAP,IRESTM,JA,JB,IOFF +INTEGER(KIND=JPIM), ALLOCATABLE :: IGPTOTL(:,:) + +REAL(KIND=JPRB) :: ZMEDIAP + +LOGICAL :: LLP1,LLP2 +REAL(KIND=JPRB),ALLOCATABLE :: ZDUM(:) +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ------------------------------------------------------------------ + +IF (LHOOK) CALL DR_HOOK('SUEMP_TRANS_MOD:SUEMP_TRANS',0,ZHOOK_HANDLE) +LLP1 = NPRINTLEV>0 +LLP2 = NPRINTLEV>1 +IF(LLP1) WRITE(NOUT,*) '=== ENTER ROUTINE SUEMP_TRANS ===' + +IF(.NOT.D%LGRIDONLY) THEN + +ALLOCATE(D%NULTPP(NPRTRNS)) +IF(LLP2)WRITE(NOUT,9) 'D%NULTPP ',SIZE(D%NULTPP ),SHAPE(D%NULTPP ) +ALLOCATE(D%NPTRLS(NPRTRNS)) +IF(LLP2)WRITE(NOUT,9) 'D%NPTRLS ',SIZE(D%NPTRLS ),SHAPE(D%NPTRLS ) +ALLOCATE(D%NPROCL(R%NDGL)) +IF(LLP2)WRITE(NOUT,9) 'D%NPROCL ',SIZE(D%NPROCL ),SHAPE(D%NPROCL ) + +CALL SUMPLATF(R%NDGL,NPRTRNS,MYSETW,D%NULTPP,D%NPROCL,D%NPTRLS) +D%NDGL_FS = D%NULTPP(MYSETW) + +! Help arrays for spectral to fourier space transposition +ALLOCATE(D%NLTSGTB (NPRTRNS+1)) +IF(LLP2)WRITE(NOUT,9) 'D%NLTSGTB ',SIZE(D%NLTSGTB),SHAPE(D%NLTSGTB) +ALLOCATE(D%NLTSFTB (NPRTRNS+1)) +IF(LLP2)WRITE(NOUT,9) 'D%NLTSFTB ',SIZE(D%NLTSFTB),SHAPE(D%NLTSFTB) +ALLOCATE(D%NSTAGT0B(NPRTRNS+1)) +IF(LLP2)WRITE(NOUT,9) 'D%NSTAGT0B ',SIZE(D%NSTAGT0B),SHAPE(D%NSTAGT0B) +ALLOCATE(D%NSTAGT1B(NPRTRNS+1)) +IF(LLP2)WRITE(NOUT,9) 'D%NSTAGT1B ',SIZE(D%NSTAGT1B),SHAPE(D%NSTAGT1B) +ALLOCATE(D%MSTABF (NPRTRNS+1)) +IF(LLP2)WRITE(NOUT,9) 'D%MSTABF ',SIZE(D%MSTABF),SHAPE(D%MSTABF) + +D%NLTSGTB(:) = 0 +DO JGL=1,D%NDGL_FS + IGL = D%NPTRLS(MYSETW)+JGL-1 + DO JM=0,G%NMEN(IGL) + D%NLTSGTB(D%NPROCM(JM)) = D%NLTSGTB(D%NPROCM(JM))+1 + ENDDO +ENDDO +DO JA=1,NPRTRW + IPLAT = 0 + DO JGL=1,D%NULTPP(JA) + IGL = D%NPTRLS(JA)+JGL-1 + DO JM=1,D%NUMP + IF(IGL > R%NDGNH-G%NDGLU(D%MYMS(JM)) .AND. IGL <= R%NDGNH+G%NDGLU(D%MYMS(JM))) THEN + IPLAT = IPLAT + 1 + ENDIF + ENDDO + ENDDO + D%NLTSFTB(JA) = IPLAT +ENDDO + +DO JA=1,NPRTRW-1 + ISENDSET = MYSENDSET(NPRTRW,MYSETW,JA) + IRECVSET = MYRECVSET(NPRTRW,MYSETW,JA) + D%MSTABF(IRECVSET) = ISENDSET +ENDDO +D%MSTABF(MYSETW) = MYSETW + +ALLOCATE(D%NPNTGTB0(0:RALD%NMSMAX,D%NDGL_FS)) +IF(LLP2)WRITE(NOUT,9) 'D%NPNTGTB0 ',SIZE(D%NPNTGTB0 ),SHAPE(D%NPNTGTB0 ) +ALLOCATE(D%NPNTGTB1(D%NUMP,R%NDGL)) +IF(LLP2)WRITE(NOUT,9) 'D%NPNTGTB1 ',SIZE(D%NPNTGTB1 ),SHAPE(D%NPNTGTB1 ) + +DO JA=1,NPRTRW + IPOS = 0 + DO JGL=1,D%NULTPP(MYSETW) + IGL = D%NPTRLS(MYSETW) + JGL - 1 + DO JML=D%NPTRMS(JA),D%NPTRMS(JA)+D%NUMPP(JA)-1 + IM = D%NALLMS(JML) + IF (IM <= G%NMEN(IGL)) THEN + D%NPNTGTB0(IM,JGL) = IPOS + IPOS = IPOS+1 + ELSE + D%NPNTGTB0(IM,JGL) = -99 + ENDIF + ENDDO + ENDDO +ENDDO + +DO JA=1,NPRTRW + IPOS = 0 + DO JGL=1,D%NULTPP(JA) + IGL = D%NPTRLS(JA) + JGL - 1 + DO JM=1,D%NUMP + IM = D%MYMS(JM) + IF (IM <= G%NMEN(IGL)) THEN + D%NPNTGTB1(JM,IGL) = IPOS + IPOS = IPOS+1 + ELSE + D%NPNTGTB1(JM,IGL) = -99 + ENDIF + ENDDO + ENDDO +ENDDO + +IAUX0 = 0 +IAUX1 = 0 +DO JA=1,NPRTRNS-1 + I1 = MYSENDSET(NPRTRNS,MYSETW,JA) + I2 = MYRECVSET(NPRTRNS,MYSETW,JA) + DO JA1=1,NPRTRNS-1 + IF(MYSENDSET(NPRTRNS,MYSETW,JA1) == I2) I3 =MYRECVSET(NPRTRNS,MYSETW,JA1) + ENDDO + IAUX0 = MAX(D%NLTSFTB(I1),D%NLTSGTB(I2),IAUX0) + IAUX1 = MAX(D%NLTSGTB(I2),D%NLTSFTB(I3),IAUX1) +ENDDO +IAUX0 = MAX(D%NLTSGTB(MYSETW),IAUX0) +IAUX1 = MAX(D%NLTSGTB(MYSETW),IAUX1) +DO JA=1,NPRTRNS+1 + D%NSTAGT0B(JA) = (JA-1)*IAUX0 + D%NSTAGT1B(JA) = (JA-1)*IAUX1 +ENDDO +D%NLENGT0B = IAUX0*NPRTRNS +D%NLENGT1B = IAUX1*NPRTRNS + +ENDIF + +! GRIDPOINT SPACE + +ALLOCATE(D%NFRSTLAT(N_REGIONS_NS)) +IF(LLP2)WRITE(NOUT,9) 'D%NFRSTLAT ',SIZE(D%NFRSTLAT ),SHAPE(D%NFRSTLAT ) +ALLOCATE(D%NLSTLAT(N_REGIONS_NS)) +IF(LLP2)WRITE(NOUT,9) 'D%NLSTLAT ',SIZE(D%NLSTLAT ),SHAPE(D%NLSTLAT ) +ALLOCATE(D%NPTRLAT(R%NDGL)) +IF(LLP2)WRITE(NOUT,9) 'D%NPTRLAT ',SIZE(D%NPTRLAT ),SHAPE(D%NPTRLAT ) +ALLOCATE(D%NPTRFRSTLAT(N_REGIONS_NS)) +IF(LLP2)WRITE(NOUT,9) 'D%NPTRFRSTLAT',SIZE(D%NPTRFRSTLAT),SHAPE(D%NPTRFRSTLAT) +ALLOCATE(D%NPTRLSTLAT(N_REGIONS_NS)) +IF(LLP2)WRITE(NOUT,9)'D%NPTRLSTLAT',SIZE(D%NPTRLSTLAT),SHAPE(D%NPTRLSTLAT) +ALLOCATE(D%LSPLITLAT(R%NDGL)) +IF(LLP2)WRITE(NOUT,9) 'D%LSPLITLAT',SIZE(D%LSPLITLAT),SHAPE(D%LSPLITLAT) +ALLOCATE(D%NPROCA_GP(N_REGIONS_NS)) +IF(LLP2)WRITE(NOUT,9) 'D%NPROCA_GP',SIZE(D%NPROCA_GP),SHAPE(D%NPROCA_GP) + + +IF(.NOT.D%LWEIGHTED_DISTR) THEN + ALLOCATE(ZDUM(1)) + CALL SUEMPLAT(R%NDGL,NPROC,N_REGIONS_NS,MY_REGION_NS,D%LSPLIT, LEQ_REGIONS,& + & D%NFRSTLAT,D%NLSTLAT,D%NFRSTLOFF,D%NPTRLAT,& + & D%NPTRFRSTLAT,D%NPTRLSTLAT,D%NPTRFLOFF,& + & ZDUM,D%LWEIGHTED_DISTR,ZMEDIAP,D%NPROCA_GP,& + & IMEDIAP,IRESTM,D%LSPLITLAT,MYPROC,G%NLOEN,RALD%NDGUX) +ELSE + CALL SUEMPLAT(R%NDGL,NPROC,N_REGIONS_NS,MY_REGION_NS,D%LSPLIT, LEQ_REGIONS,& + & D%NFRSTLAT,D%NLSTLAT,D%NFRSTLOFF,D%NPTRLAT,& + & D%NPTRFRSTLAT,D%NPTRLSTLAT,D%NPTRFLOFF,& + & D%RWEIGHT,D%LWEIGHTED_DISTR,ZMEDIAP,D%NPROCA_GP,& + & IMEDIAP,IRESTM,D%LSPLITLAT,MYPROC,G%NLOEN,RALD%NDGUX) +ENDIF +D%NDGL_GP = D%NLSTLAT(MY_REGION_NS)-D%NFRSTLOFF + +IF (LLP1) THEN + IF(.NOT.D%LGRIDONLY) THEN + WRITE(NOUT,FMT='(/'' OUTPUT FROM ROUTINE SUEMPLAT: ''/)') + WRITE(NOUT,FMT='('' D%NULTPP '')') + WRITE(NOUT,FMT='(20(1X,I4))') D%NULTPP(1:NPRTRNS) + WRITE(NOUT,FMT='('' D%NPROCL '')') + WRITE(NOUT,FMT='(20(1X,I4))') D%NPROCL(1:R%NDGL) + ENDIF + WRITE(NOUT,FMT='('' D%NFRSTLAT '')') + WRITE(NOUT,FMT='(20(1X,I4))') D%NFRSTLAT(1:N_REGIONS_NS) + WRITE(NOUT,FMT='('' D%NLSTLAT '')') + WRITE(NOUT,FMT='(20(1X,I4))') D%NLSTLAT(1:N_REGIONS_NS) + WRITE(NOUT,FMT='('' D%NFRSTLOFF D%NPTRFLOFF '')') + WRITE(NOUT,FMT='(2(1X,I6))') D%NFRSTLOFF, D%NPTRFLOFF + WRITE(NOUT,FMT='('' D%NPTRLAT '')') + WRITE(NOUT,FMT='(20(1X,I4))') D%NPTRLAT(1:R%NDGL) + WRITE(NOUT,FMT='('' D%LSPLITLAT '')') + WRITE(NOUT,FMT='(50(1X,L1))') D%LSPLITLAT(1:R%NDGL) + WRITE(NOUT,FMT='('' D%NPTRFRSTLAT '')') + WRITE(NOUT,FMT='(20(1X,I4))') D%NPTRFRSTLAT(1:N_REGIONS_NS) + WRITE(NOUT,FMT='('' D%NPTRLSTLAT '')') + WRITE(NOUT,FMT='(20(1X,I4))') D%NPTRLSTLAT(1:N_REGIONS_NS) + WRITE(NOUT,FMT='(/)') +ENDIF +ALLOCATE(D%NSTA(R%NDGL+N_REGIONS_NS-1,N_REGIONS_EW)) +IF(LLP2)WRITE(NOUT,9) 'D%NSTA ',SIZE(D%NSTA ),SHAPE(D%NSTA ) +ALLOCATE(D%NONL(R%NDGL+N_REGIONS_NS-1,N_REGIONS_EW)) +IF(LLP2)WRITE(NOUT,9) 'D%NONL ',SIZE(D%NONL ),SHAPE(D%NONL ) + +IF(.NOT.D%LWEIGHTED_DISTR) THEN + CALL SUESTAONL(IMEDIAP,IRESTM,D%LWEIGHTED_DISTR,ZDUM,ZMEDIAP,D%NPROCA_GP) +ELSE + CALL SUESTAONL(IMEDIAP,IRESTM,D%LWEIGHTED_DISTR,D%RWEIGHT,ZMEDIAP,D%NPROCA_GP) +ENDIF +! IGPTOTL is the number of grid points in each individual processor +ALLOCATE(IGPTOTL(N_REGIONS_NS,N_REGIONS_EW)) +IGPTOTL(:,:)=0 +DO JA=1,N_REGIONS_NS + DO JB=1,N_REGIONS(JA) + IGPTOT = 0 + DO JGL=D%NPTRFRSTLAT(JA),D%NPTRLSTLAT(JA) + IGPTOT = IGPTOT+D%NONL(JGL,JB) + ENDDO + IGPTOTL(JA,JB) = IGPTOT + ENDDO +ENDDO +D%NGPTOT = IGPTOTL(MY_REGION_NS,MY_REGION_EW) +D%NGPTOTMX = MAXVAL(IGPTOTL) +D%NGPTOTG = SUM(IGPTOTL) +ALLOCATE(D%NGPTOTL(N_REGIONS_NS,N_REGIONS_EW)) +IF(LLP2)WRITE(NOUT,9) 'D%NGPTOTL ',SIZE(D%NGPTOTL ),SHAPE(D%NGPTOTL ) +D%NGPTOTL(:,:) = IGPTOTL(:,:) + +IF(.NOT.D%LGRIDONLY) THEN +ALLOCATE(D%NSTAGTF(D%NDGL_FS)) +IF(LLP2)WRITE(NOUT,9) 'D%NSTAGTF ',SIZE(D%NSTAGTF ),SHAPE(D%NSTAGTF ) +IOFF = 0 +DO JGL=1,D%NDGL_FS + D%NSTAGTF(JGL) = IOFF + IGL = D%NPTRLS(MYSETW) + JGL - 1 + IOFF = IOFF + G%NLOEN(IGL)+3+R%NNOEXTZL +ENDDO +D%NLENGTF = IOFF +ENDIF + +IF(ALLOCATED(ZDUM)) DEALLOCATE(ZDUM) +DEALLOCATE(IGPTOTL) +IF (LHOOK) CALL DR_HOOK('SUEMP_TRANS_MOD:SUEMP_TRANS',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ +9 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8) + +END SUBROUTINE SUEMP_TRANS +END MODULE SUEMP_TRANS_MOD + diff --git a/src/etrans/etrans/internal/suemp_trans_preleg_mod.F90 b/src/etrans/etrans/internal/suemp_trans_preleg_mod.F90 new file mode 100644 index 000000000..34f3fb7cd --- /dev/null +++ b/src/etrans/etrans/internal/suemp_trans_preleg_mod.F90 @@ -0,0 +1,240 @@ +MODULE SUEMP_TRANS_PRELEG_MOD +CONTAINS +SUBROUTINE SUEMP_TRANS_PRELEG + +! Set up distributed environment for the transform package (part 1) + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_GEN ,ONLY : NOUT, NPRINTLEV +USE TPM_DIM ,ONLY : R +USE TPM_DISTR ,ONLY : D, NPRTRW, NPRTRV, MYSETW + +USE TPMALD_DISTR ,ONLY : DALD +USE TPMALD_DIM ,ONLY : RALD +USE TPMALD_FIELDS ,ONLY : FALD +USE TPMALD_GEO ,ONLY : GALD + +!USE SUWAVEDI_MOD +!USE ABORT_TRANS_MOD + +IMPLICIT NONE + + INTEGER(KIND=JPIM) :: JA,JM,JMLOC,JW,JV,ILATPP,IRESTL,IMLOC,IDT,INM,JN,IM,ILAST + + LOGICAL :: LLP1,LLP2 + + INTEGER(KIND=JPIM) :: ISPEC(NPRTRW),IMYMS(RALD%NMSMAX+1),IKNTMP(0:RALD%NMSMAX) + INTEGER(KIND=JPIM) :: IKMTMP(0:R%NSMAX),ISPEC2P + INTEGER(KIND=JPIM) :: IC(NPRTRW) + INTEGER(KIND=JPIM) :: IMDIM,IL,IND,IK,IPOS,IKM + REAL(KIND=JPRB) :: ZLEPDIM + REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + + ! ------------------------------------------------------------------ + + IF (LHOOK) CALL DR_HOOK('SUEMP_TRANS_PRELEG_MOD:SUEMP_TRANS_PRELEG',0,ZHOOK_HANDLE) + + IF(.NOT.D%LGRIDONLY) THEN + + LLP1 = NPRINTLEV>0 + LLP2 = NPRINTLEV>1 + IF(LLP1) WRITE(NOUT,*) '=== ENTER ROUTINE SUEMP_TRANS_PRELEG ===' + + !* 1. Initialize partitioning of wave numbers to PEs ! + ! ---------------------------------------------- + + ALLOCATE(D%NASM0(0:R%NSMAX)) + IF(LLP2)WRITE(NOUT,9) 'D%NASM0 ',SIZE(D%NASM0 ),SHAPE(D%NASM0 ) + + ALLOCATE(DALD%NESM0(0:RALD%NMSMAX)) + IF(LLP2)WRITE(NOUT,9) 'DALD%NESM0 ',SIZE(DALD%NESM0 ),SHAPE(DALD%NESM0 ) + + ALLOCATE(D%NATM0(0:R%NTMAX)) + IF(LLP2)WRITE(NOUT,9) 'D%NATM0 ',SIZE(D%NATM0 ),SHAPE(D%NATM0 ) + ALLOCATE(D%NUMPP(NPRTRW)) + IF(LLP2)WRITE(NOUT,9) 'D%NUMPP ',SIZE(D%NUMPP ),SHAPE(D%NUMPP ) + ALLOCATE(D%NPOSSP(NPRTRW+1)) + IF(LLP2)WRITE(NOUT,9) 'D%NPOSSP',SIZE(D%NPOSSP ),SHAPE(D%NPOSSP ) + + ALLOCATE(D%NPROCM(0:RALD%NMSMAX)) + IF(LLP2)WRITE(NOUT,9) 'D%NPROCM',SIZE(D%NPROCM ),SHAPE(D%NPROCM ) + + ALLOCATE(DALD%NPME(0:RALD%NMSMAX)) + IF(LLP2)WRITE(NOUT,9) 'DALD%NPME',SIZE(DALD%NPME),SHAPE(DALD%NPME) + ALLOCATE(DALD%NCPL2M(0:RALD%NMSMAX)) + IF(LLP2)WRITE(NOUT,9) 'DALD%NCPL2M',SIZE(DALD%NCPL2M),SHAPE(DALD%NCPL2M) + CALL ELLIPS(R%NSMAX,RALD%NMSMAX,IKNTMP,IKMTMP) + DALD%NPME(0)=1 + DO JM=1,RALD%NMSMAX + DALD%NPME(JM)=DALD%NPME(JM-1)+IKNTMP(JM-1)+1 + ENDDO + DO JM=0,RALD%NMSMAX + DALD%NCPL2M(JM) = 2*(IKNTMP(JM)+1) + ENDDO + ALLOCATE(FALD%RLEPINM(R%NSPEC_G/2)) + IF(LLP2)WRITE(NOUT,9) 'FALD%RLEPINM',SIZE(FALD%RLEPINM),SHAPE(FALD%RLEPINM) + DO JM=0,RALD%NMSMAX + DO JN=1,IKNTMP(JM) + ZLEPDIM=-((REAL(JM,JPRB)**2)*(GALD%EXWN**2)+& + & (REAL(JN,JPRB)**2)*(GALD%EYWN**2)) + FALD%RLEPINM(DALD%NPME(JM)+JN)=1./ZLEPDIM + ENDDO + ENDDO + DO JM=1,RALD%NMSMAX + ZLEPDIM=-(REAL(JM,JPRB)**2)*(GALD%EXWN**2) + FALD%RLEPINM(DALD%NPME(JM))=1./ZLEPDIM + ENDDO + FALD%RLEPINM(DALD%NPME(0))=0. + + D%NUMPP(:) = 0 + ISPEC(:) = 0 + DALD%NESM0(:)=-99 + + IMDIM = 0 + IL = 1 + IND = 1 + IK = 0 + IPOS = 1 + DO JM=0,RALD%NMSMAX + IK = IK + IND + IF (IK > NPRTRW) THEN + IK = NPRTRW + IND = -1 + ELSEIF (IK < 1) THEN + IK = 1 + IND = 1 + ENDIF + + IKM =DALD%NCPL2M(JM)/2 -1 + D%NPROCM(JM) = IK + ISPEC(IK) = ISPEC(IK)+IKM+1 + D%NUMPP(IK) = D%NUMPP(IK)+1 + IF (IK == MYSETW) THEN + IMDIM = IMDIM + IKM+1 + IMYMS(IL) = JM + DALD%NESM0(JM) = IPOS + IPOS = IPOS+(IKM+1)*4 + IL = IL+1 + ENDIF + ENDDO + D%NPOSSP(1) = 1 + ISPEC2P = 4*ISPEC(1) + D%NSPEC2MX = ISPEC2P + DO JA=2,NPRTRW + D%NPOSSP(JA) = D%NPOSSP(JA-1)+ISPEC2P + ISPEC2P = 4*ISPEC(JA) + D%NSPEC2MX=MAX(D%NSPEC2MX,ISPEC2P) + ENDDO + D%NPOSSP(NPRTRW+1) = D%NPOSSP(NPRTRW)+ISPEC2P + + D%NSPEC2 = 4*IMDIM + D%NSPEC=D%NSPEC2 + + D%NUMP = D%NUMPP (MYSETW) + ALLOCATE(D%MYMS(D%NUMP)) + IF(LLP2)WRITE(NOUT,9) 'D%MYMS ',SIZE(D%MYMS ),SHAPE(D%MYMS ) + D%MYMS(:) = IMYMS(1:D%NUMP) + D%NUMTP = D%NUMP + + ! pointer to the first wave number of a given wave-set in NALLMS array + ALLOCATE(D%NPTRMS(NPRTRW)) + IF(LLP2)WRITE(NOUT,9) 'D%NPTRMS ',SIZE(D%NPTRMS ),SHAPE(D%NPTRMS ) + D%NPTRMS(:) = 1 + DO JA=2,NPRTRW + D%NPTRMS(JA) = D%NPTRMS(JA-1)+D%NUMPP(JA-1) + ENDDO + ! D%NALLMS : wave numbers for all wave-set concatenated together to give all + ! wave numbers in wave-set order. + ALLOCATE(D%NALLMS(RALD%NMSMAX+1)) + IF(LLP2)WRITE(NOUT,9) 'D%NALLMS ',SIZE(D%NALLMS ),SHAPE(D%NALLMS ) + IC(:) = 0 + DO JM=0,RALD%NMSMAX + D%NALLMS(IC(D%NPROCM(JM))+D%NPTRMS(D%NPROCM(JM))) = JM + IC(D%NPROCM(JM)) = IC(D%NPROCM(JM))+1 + ENDDO + ALLOCATE(D%NDIM0G(0:RALD%NMSMAX)) + IF(LLP2)WRITE(NOUT,9) 'D%NDIM0G ',SIZE(D%NDIM0G ),SHAPE(D%NDIM0G ) + IPOS = 1 + DO JA=1,NPRTRW + DO JMLOC=1,D%NUMPP(JA) + IM = D%NALLMS(D%NPTRMS(JA)+JMLOC-1) + D%NDIM0G(IM) = IPOS + IPOS = IPOS+2*DALD%NCPL2M(IM) + ENDDO + ENDDO + +ALLOCATE(D%NLATLS(NPRTRW,NPRTRV)) +IF(LLP2)WRITE(NOUT,9) 'D%NLATLS',SIZE(D%NLATLS ),SHAPE(D%NLATLS ) +ALLOCATE(D%NLATLE(NPRTRW,NPRTRV)) +IF(LLP2)WRITE(NOUT,9) 'D%NLATLE',SIZE(D%NLATLE ),SHAPE(D%NLATLE ) + +D%NLATLS(:,:) = 9999 +D%NLATLE(:,:) = -1 + +ILATPP = R%NDGL/NPRTRW +IRESTL = R%NDGL-NPRTRW*ILATPP +DO JW=1,NPRTRW + IF (JW > IRESTL) THEN + D%NLATLS(JW,1) = IRESTL*(ILATPP+1)+(JA-IRESTL-1)*ILATPP+1 + D%NLATLE(JW,1) = D%NLATLS(JW,1)+ILATPP-1 + ELSE + D%NLATLS(JW,1) = (JA-1)*(ILATPP+1)+1 + D%NLATLE(JW,1) = D%NLATLS(JW,1)+ILATPP + ENDIF +ENDDO +ILAST=0 +DO JW=1,NPRTRW + ILATPP = (D%NLATLE(JW,1)-D%NLATLS(JW,1)+1)/NPRTRV + IRESTL = (D%NLATLE(JW,1)-D%NLATLS(JW,1)+1)-NPRTRV*ILATPP + DO JV=1,NPRTRV + IF (JV > IRESTL) THEN + D%NLATLS(JW,JV) = IRESTL*(ILATPP+1)+(JV-IRESTL-1)*ILATPP+1+ILAST + D%NLATLE(JW,JV) = D%NLATLS(JW,JV)+ILATPP-1 + ELSE + D%NLATLS(JW,JV) = (JV-1)*(ILATPP+1)+1+ILAST + D%NLATLE(JW,JV) = D%NLATLS(JW,JV)+ILATPP + ENDIF + ENDDO + ILAST=D%NLATLE(JW,NPRTRV) +ENDDO +IF (LLP1) THEN + DO JW=1,NPRTRW + DO JV=1,NPRTRV + WRITE(NOUT,'(" JW=",I6," JV=",I6," D%NLATLS=",I6," D%NLATLE=",I6)')& + & JW,JV,D%NLATLS(JW,JV),D%NLATLE(JW,JV) + ENDDO + ENDDO +ENDIF + +ALLOCATE(D%NPMT(0:R%NSMAX)) +IF(LLP2)WRITE(NOUT,9) 'D%NPMT ',SIZE(D%NPMT ),SHAPE(D%NPMT ) +ALLOCATE(D%NPMS(0:R%NSMAX)) +IF(LLP2)WRITE(NOUT,9) 'D%NPMS ',SIZE(D%NPMS ),SHAPE(D%NPMS ) +ALLOCATE(D%NPMG(0:R%NSMAX)) +IF(LLP2)WRITE(NOUT,9) 'D%NPMG ',SIZE(D%NPMG ),SHAPE(D%NPMG ) +IDT = R%NTMAX-R%NSMAX +INM = 0 +DO JMLOC=1,D%NUMP + IMLOC = D%MYMS(JMLOC) + + INM = INM+R%NTMAX+2-IMLOC +ENDDO +INM = 0 +DO JM=0,R%NSMAX + + INM = INM+R%NTMAX+2-JM +ENDDO + +D%NLEI3D = (R%NLEI3-1)/NPRTRW+1 + +ENDIF + +IF (LHOOK) CALL DR_HOOK('SUEMP_TRANS_PRELEG_MOD:SUEMP_TRANS_PRELEG',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ +9 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8) + +END SUBROUTINE SUEMP_TRANS_PRELEG +END MODULE SUEMP_TRANS_PRELEG_MOD diff --git a/src/etrans/etrans/internal/suemplat_mod.F90 b/src/etrans/etrans/internal/suemplat_mod.F90 new file mode 100644 index 000000000..c06f31695 --- /dev/null +++ b/src/etrans/etrans/internal/suemplat_mod.F90 @@ -0,0 +1,252 @@ +MODULE SUEMPLAT_MOD +CONTAINS +SUBROUTINE SUEMPLAT(KDGL,KPROC,KPROCA,KMYSETA,LDSPLIT,LDEQ_REGIONS,& + & KFRSTLAT,KLSTLAT,KFRSTLOFF,KPTRLAT,& + & KPTRFRSTLAT,KPTRLSTLAT,KPTRFLOFF,& + & PWEIGHT,LDWEIGHTED_DISTR,PMEDIAP,KPROCAGP,& + & KMEDIAP,KRESTM,LDSPLITLAT,KMYPROC,KLOEN,KDGUX) + +!**** *SUEMPLAT * - Initialize gridpoint distrbution in N-S direction + +! Purpose. +! -------- + +!** Interface. +! ---------- +! *CALL* *SUEMPLAT * + +! Explicit arguments - input : +! -------------------- +! KDGL -last latitude +! KPROC -total number of processors +! KPROCA -number of processors in A direction +! KMYSETA -process number in A direction +! LDSPLIT -true for latitudes shared between sets +! PWEIGHT -weight per grid-point if weighted +! distribution +! LDEQ_REGIONS -true if eq_regions partitioning +! LDWEIGHTED_DISTR -true if weighted distribution + +! Explicit arguments - output: +! -------------------- +! KMEDIAP -mean number of grid points per PE +! KRESTM -number of PEs with one extra point +! KFRSTLAT -first latitude row on processor +! KLSTLAT -last latitude row on processor +! KFRSTLOFF -offset for first latitude in set +! KPROCAGP -number of grid points per A set +! KPTRLAT -pointer to start of latitude +! KPTRFRSTLAT-pointer to first latitude +! KPTRLSTLAT -pointer to last latitude +! KPTRFLOFF -offset for pointer to first latitude +! LDSPLITLAT -true for latitudes which are split +! PMEDIAP -mean weight per PE if weighted +! distribution +! + +! Implicit arguments : +! -------------------- + +! Method. +! ------- +! See documentation + +! Externals. SUMPLATB and SUEMPLATB. +! ---------- + +! Reference. +! ---------- +! ECMWF Research Department documentation of the IFS + +! Author. +! ------- +! MPP Group *ECMWF* + +! Modifications. +! -------------- +! Original : 95-10-01 +! David Dent:97-06-02 parameters KFRSTLAT etc added +! JF. Estrade:97-11-13 Adaptation to ALADIN case +! J.Boutahar: 98-07-06 phasing with CY19 +! Modified 98-08-10 by K. YESSAD: removal of LRPOLE option + cleanings +! (correct computation of extrapolar latitudes for KPROCL). +! Modified 98-12-07 by K. YESSAD and C. FISCHER: cleaning. +! - merge old sumplat.F and suemplat.F +! - gather 'lelam' code and 'not lelam' code. +! - clean (useless duplication of variables, non doctor features). +! - remodularise according to lelam/not lelam +! -> lelam features in new routine suemplatb.F, +! not lelam features in new routine sumplatb.F +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! A.Bogatchev 20-Sep-2010 Phasing cy37 +! R. El Khatib 09-Aug-2013 Allow LEQ_REGIONS +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE TPM_GEN ,ONLY : NOUT, NPRINTLEV + +USE SUEMPLATB_MOD ,ONLY : SUEMPLATB +USE SUMPLATBEQ_MOD ,ONLY : SUMPLATBEQ +USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS +! + +IMPLICIT NONE + +! * DUMMY: +INTEGER(KIND=JPIM),INTENT(OUT) :: KMEDIAP +INTEGER(KIND=JPIM),INTENT(OUT) :: KRESTM +INTEGER(KIND=JPIM),INTENT(IN) :: KDGL +INTEGER(KIND=JPIM),INTENT(IN) :: KPROC +INTEGER(KIND=JPIM),INTENT(IN) :: KPROCA +INTEGER(KIND=JPIM),INTENT(IN) :: KMYSETA +INTEGER(KIND=JPIM),INTENT(OUT) :: KFRSTLAT(:) +INTEGER(KIND=JPIM),INTENT(OUT) :: KLSTLAT(:) +INTEGER(KIND=JPIM),INTENT(OUT) :: KFRSTLOFF +INTEGER(KIND=JPIM),INTENT(OUT) :: KPTRLAT(:) +INTEGER(KIND=JPIM),INTENT(OUT) :: KPTRFRSTLAT(:) +INTEGER(KIND=JPIM),INTENT(OUT) :: KPTRLSTLAT(:) +INTEGER(KIND=JPIM),INTENT(OUT) :: KPTRFLOFF +INTEGER(KIND=JPIM),INTENT(OUT) :: KPROCAGP(KPROCA) +REAL(KIND=JPRB),INTENT(OUT) :: PMEDIAP +REAL(KIND=JPRB),INTENT(IN) :: PWEIGHT(:) + +LOGICAL,INTENT(IN) :: LDSPLIT +LOGICAL,INTENT(IN) :: LDEQ_REGIONS +LOGICAL,INTENT(OUT) :: LDSPLITLAT(:) +LOGICAL,INTENT(INOUT) :: LDWEIGHTED_DISTR +INTEGER(KIND=JPIM),INTENT(IN) :: KMYPROC +INTEGER(KIND=JPIM),INTENT(IN) :: KLOEN(KDGL) +INTEGER(KIND=JPIM),INTENT(IN) :: KDGUX + +! === END OF INTERFACE BLOCK === +INTEGER(KIND=JPIM) :: INDIC(KPROCA),ILAST(KPROCA) + +INTEGER(KIND=JPIM) :: IPTRLATITUDE, JA, JGL +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +LOGICAL :: LLFOURIER +LOGICAL :: LLDEBUG=.FALSE. + +! ----------------------------------------------------------------- + +!* 1. CODE DEPENDING ON 'LELAM': COMPUTATION OF +! KMEDIAP, KRESTM, INDIC, ILAST. +! ----------------------------------------- + +IF (LHOOK) CALL DR_HOOK('SUEMPLAT_MOD:SUEMPLAT',0,ZHOOK_HANDLE) + +INDIC(:)=0 +ILAST(:)=0 + +IF(LDWEIGHTED_DISTR.AND..NOT.LDEQ_REGIONS)THEN + CALL ABORT_TRANS ('SUEMPLAT: LDWEIGHTED_DISTR=T AND LDEQ_REGIONS=F NOT SUPPORTED') +ENDIF + +IF( LDEQ_REGIONS )THEN + CALL SUMPLATBEQ(1,KDGL,KPROC,KPROCA,KLOEN,LDSPLIT,LDEQ_REGIONS,& + &PWEIGHT,LDWEIGHTED_DISTR,PMEDIAP,KPROCAGP,& + &KMEDIAP,KRESTM,INDIC,ILAST) +ELSE + LLFOURIER=.FALSE. +!REK commented out for now ... monkey business to be done again, should lead to the use of sumplatb +!REK CALL SUMPLATB(1,KDGL,KPROCA,G%NLOEN,LDSPLIT,LLFOURIER,& +!REK &KMEDIAP,KRESTM,INDIC,ILAST) + CALL SUEMPLATB(1,KDGL,KPROCA,KLOEN,LDSPLIT,& + & PWEIGHT,LDWEIGHTED_DISTR,PMEDIAP,KPROCAGP,& + & KMEDIAP,KRESTM,INDIC,ILAST,KDGUX) +ENDIF + +! ----------------------------------------------------------------- + +!* 2. CODE NOT DEPENDING ON 'LELAM': COMPUTATION OF +! KFRSTLAT TO LDSPLITLAT. +! --------------------------------------------- + +! * Computation of first and last latitude of processor sets +! ----------- in grid-point-space ----------------------- +IF(KMYPROC==1.AND.LLDEBUG)THEN + WRITE(0,'("")') + WRITE(0,'("SUEMPLAT_MOD:LDWEIGHTED_DISTR=",L1)')LDWEIGHTED_DISTR + WRITE(0,'("")') + DO JA=1,KPROCA + WRITE(0,'("SUEMPLAT_MOD: JA=",I3," ILAST=",I3," INDIC=",I3)')& + &JA,ILAST(JA),INDIC(JA) + ENDDO + WRITE(0,'("")') + IF( LDEQ_REGIONS .AND. LDSPLIT )THEN + DO JA=1,KPROCA + WRITE(0,'("SUEMPLAT_MOD: JA=",I3," KPROCAGP=",I8)')& + &JA,KPROCAGP(JA) + ENDDO + WRITE(0,'("")') + ENDIF +ENDIF +KFRSTLAT(1) = 1 +KLSTLAT(KPROCA) = KDGL +DO JA=1,KPROCA-1 + IF(KMYPROC==1 .AND. NPRINTLEV > 1)THEN + WRITE(NOUT,'("SUEMPLAT_MOD: JA=",I3," ILAST=",I3," INDIC=",I3)')& + &JA,ILAST(JA),INDIC(JA) + ENDIF + IF ((.NOT. LDSPLIT) .OR. INDIC(JA) == 0) THEN + KFRSTLAT(JA+1) = ILAST(JA) + 1 + KLSTLAT(JA) = ILAST(JA) + ELSE + KFRSTLAT(JA+1) = INDIC(JA) + KLSTLAT(JA) = INDIC(JA) + ENDIF +ENDDO +KFRSTLOFF=KFRSTLAT(KMYSETA)-1 + +! * Initialise following data structures:- +! NPTRLAT (pointer to the start of each latitude) +! LSPLITLAT (TRUE if latitude is split over two A sets) +! NPTRFRSTLAT (pointer to the first latitude of each A set) +! NPTRLSTLAT (pointer to the last latitude of each A set) + +DO JGL=1,KDGL + KPTRLAT (JGL)=-999 + LDSPLITLAT(JGL)=.FALSE. +ENDDO +IPTRLATITUDE=0 +DO JA=1,KPROCA + DO JGL=KFRSTLAT(JA),KLSTLAT(JA) + IPTRLATITUDE=IPTRLATITUDE+1 + LDSPLITLAT(JGL)=.TRUE. + IF( KPTRLAT(JGL) == -999 )THEN + KPTRLAT(JGL)=IPTRLATITUDE + LDSPLITLAT(JGL)=.FALSE. + ENDIF + ENDDO +ENDDO +DO JA=1,KPROCA + IF( LDSPLITLAT(KFRSTLAT(JA)) .AND. JA /= 1 )THEN + KPTRFRSTLAT(JA)=KPTRLAT(KFRSTLAT(JA))+1 + ELSE + KPTRFRSTLAT(JA)=KPTRLAT(KFRSTLAT(JA)) + ENDIF + IF( LDSPLITLAT(KLSTLAT(JA)) .AND. JA == KPROCA)THEN + KPTRLSTLAT(JA)=KPTRLAT(KLSTLAT(JA))+1 + ELSE + KPTRLSTLAT(JA)=KPTRLAT(KLSTLAT(JA)) + ENDIF +ENDDO +KPTRFLOFF=KPTRFRSTLAT(KMYSETA)-1 +IF(KMYPROC==1 .AND. NPRINTLEV > 1)THEN + DO JGL=1,KDGL + WRITE(NOUT,'("SUEMPLAT_MOD: JGL=",I3," KPTRLAT=",I3," LDSPLITLAT=",L4)')& + & JGL,KPTRLAT(JGL),LDSPLITLAT(JGL) + ENDDO + DO JA=1,KPROCA + WRITE(NOUT,'("SUEMPLAT_MOD: JA=",I3," KFRSTLAT=",I3," KLSTLAT=",I3,& + & " KPTRFRSTLAT=",I3," KPTRLSTLAT=",I3)')& + & JA,KFRSTLAT(JA),KLSTLAT(JA),KPTRFRSTLAT(JA),KPTRLSTLAT(JA) + ENDDO +ENDIF + +IF (LHOOK) CALL DR_HOOK('SUEMPLAT_MOD:SUEMPLAT',1,ZHOOK_HANDLE) +END SUBROUTINE SUEMPLAT +END MODULE SUEMPLAT_MOD + diff --git a/src/etrans/etrans/internal/suemplatb_mod.F90 b/src/etrans/etrans/internal/suemplatb_mod.F90 new file mode 100644 index 000000000..a7361777b --- /dev/null +++ b/src/etrans/etrans/internal/suemplatb_mod.F90 @@ -0,0 +1,236 @@ +MODULE SUEMPLATB_MOD +CONTAINS +SUBROUTINE SUEMPLATB(KDGSA,KDGL,KPROCA,KLOENG,LDSPLIT,& + & PWEIGHT,LDWEIGHTED_DISTR,PMEDIAP,KPROCAGP,& + & KMEDIAP,KRESTM,KINDIC,KLAST,KDGUX) + +!**** *SUMPLATB * - Routine to initialize parallel environment + +! Purpose. +! -------- + +!** Interface. +! ---------- +! *CALL* *SUMPLATB * + +! Explicit arguments - input : +! -------------------- +! KDGSA -first latitude (grid-space) +! (may be different from NDGSAG) +! KDGL -last latitude +! KPROCA -number of processors in A direction +! KLOENG -actual number of longitudes per latitude. +! LDSPLIT -true for latitudes shared between sets +! KDGUX -last latitude for meaningful computations +! (suggested to pass NDGUX in gp-space, NDGL in Fourier space +! for having a good load-balance) +! PWEIGHT -weight per grid-point if weighted distribution +! LDWEIGHTED_DISTR -true if weighted distribution` + +! Explicit arguments - output: +! -------------------- +! KMEDIAP -mean number of grid points per PE +! KPROCAGP -number of grid points per A set +! KRESTM -number of PEs with one extra point +! KINDIC -intermediate quantity for 'sumplat' +! KLAST -intermediate quantity for 'sumplat' +! PMEDIAP -mean weight per PE if weighted distribution + +! Implicit arguments : +! -------------------- + +! Method. +! ------- +! See documentation + +! Externals. NONE. +! ---------- + +! Reference. +! ---------- +! ECMWF Research Department documentation of the IFS + +! Author. +! ------- +! K. YESSAD (after old version of sumplat.F). + +! Modifications. +! -------------- +! Original : 98-12-07 +! G. Radnoti: 03-03-03: Semi-merge with sumplatb, only difference: +! NS-partitioning according to NDGUX +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! A.Bogatchev 21-Sep-2010 phasing CY37 +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS +! + +IMPLICIT NONE + +! * DUMMY: +INTEGER(KIND=JPIM),INTENT(IN) :: KDGSA +INTEGER(KIND=JPIM),INTENT(IN) :: KDGL +INTEGER(KIND=JPIM),INTENT(IN) :: KPROCA +INTEGER(KIND=JPIM),INTENT(IN) :: KLOENG(KDGSA:KDGL) +REAL(KIND=JPRB),INTENT(IN) :: PWEIGHT(:) +LOGICAL,INTENT(IN) :: LDSPLIT +LOGICAL,INTENT(INOUT) :: LDWEIGHTED_DISTR +INTEGER(KIND=JPIM),INTENT(IN) :: KDGUX +INTEGER(KIND=JPIM),INTENT(OUT) :: KMEDIAP +INTEGER(KIND=JPIM),INTENT(OUT) :: KRESTM +INTEGER(KIND=JPIM),INTENT(OUT) :: KINDIC(KPROCA) +INTEGER(KIND=JPIM),INTENT(OUT) :: KLAST(KPROCA) +INTEGER(KIND=JPIM),INTENT(IN) :: KPROCAGP(KPROCA) +REAL(KIND=JPRB),INTENT(IN) :: PMEDIAP + +INTEGER(KIND=JPIM) :: IPP1(KPROCA),ILAST1(KPROCA) +INTEGER(KIND=JPIM) :: IPP(KPROCA) +INTEGER(KIND=JPIM) :: IFIRST(KPROCA) + +INTEGER(KIND=JPIM) :: ICOMP, IGL, IMAXI, IMAXIOL, IMEDIA, ITOT, JA, JGL,& + & ILAST,IREST,ILIMIT,IFRST +LOGICAL :: LLDONE +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +! ----------------------------------------------------------------- + +!* 1. COMPUTATION OF KMEDIAP, KRESTM, KINDIC, KLAST. +! ---------------------------------------------- + +! * Computation of KMEDIAP and KRESTM. + +IF (LHOOK) CALL DR_HOOK('SUEMPLATB_MOD:SUEMPLATB',0,ZHOOK_HANDLE) +IF (LDWEIGHTED_DISTR) THEN + CALL ABORT_TRANS ('SUMPLATBEQ: ALADIN CODE IS NOT PREPARED FOR WEIGHTED DISTRIBUTION') +ENDIF +IMEDIA = SUM(KLOENG(KDGSA:KDGUX)) +KMEDIAP = IMEDIA / KPROCA +IF (KMEDIAP < KLOENG(KDGL/2)) THEN + CALL ABORT_TRANS ('SUMPLATB: KPROCA TOO BIG FOR THIS RESOLUTION') +ENDIF +KRESTM = IMEDIA - KMEDIAP * KPROCA +IF (KRESTM > 0) KMEDIAP = KMEDIAP + 1 + +! * Computation of intermediate quantities KINDIC and KLAST + +IF (LDSPLIT) THEN + + IREST = 0 + ILAST =0 + DO JA=1,KPROCA + IF (JA <= KRESTM .OR. KRESTM == 0) THEN + ICOMP = KMEDIAP + ELSE + ICOMP = KMEDIAP - 1 + ENDIF + ITOT = IREST + IGL = ILAST+1 + DO JGL=IGL,KDGUX + ILAST = JGL + IF(ITOT+KLOENG(JGL) < ICOMP) THEN + ITOT = ITOT+KLOENG(JGL) + ELSEIF(ITOT+KLOENG(JGL) == ICOMP) THEN + IREST = 0 + KLAST(JA) = JGL + KINDIC(JA) = 0 + EXIT + ELSE + IREST = KLOENG(JGL) -(ICOMP-ITOT) + KLAST(JA) = JGL + KINDIC(JA) = JGL + EXIT + ENDIF + ENDDO + ENDDO + KLAST(KPROCA)=KDGL + KINDIC(KPROCA)=0 +ELSE + + KINDIC(:) = 0 + + IMAXI = KMEDIAP-1 + IMAXIOL = HUGE(IMAXIOL) + DO + ILIMIT = IMAXI + IMAXI = 0 + IFRST = KDGUX + ILAST1(:) = 0 + IPP1(:) = 0 + DO JA=KPROCA,1,-1 + IGL = IFRST + LATS:DO JGL=IGL,1,-1 + IF (IPP1(JA) < ILIMIT .OR. JA == 1) THEN + IFRST = JGL-1 + IPP1(JA) = IPP1(JA) + KLOENG(JGL) + IF(ILAST1(JA) == 0) ILAST1(JA) = JGL + ELSE + EXIT LATS + ENDIF + ENDDO LATS + IMAXI = MAX (IMAXI,IPP1(JA)) + ENDDO + IF(IMAXI >= IMAXIOL) EXIT + KLAST(:) = ILAST1(:) + IPP(:) = IPP1(:) + IMAXIOL = IMAXI + ENDDO + +! make the distribution more uniform +! ---------------------------------- + + IFIRST(1) = 0 + IF (KLAST(1) > 0) IFIRST(1) = 1 + DO JA=2,KPROCA + IF (IPP(JA) > 0) THEN + IFIRST(JA) = KLAST(JA-1)+1 + ELSE + IFIRST(JA) = 0 + ENDIF + ENDDO + + LLDONE = .FALSE. + DO WHILE( .NOT.LLDONE ) + LLDONE = .TRUE. + + DO JA=1,KPROCA-1 + IF (IPP(JA) > IPP(JA+1)) THEN + IF (IPP(JA)-IPP(JA+1) > IPP(JA+1) + 2 *& + & KLOENG(KLAST(JA)) -IPP(JA) ) THEN + IPP(JA) = IPP(JA) - KLOENG(KLAST(JA)) + IPP(JA+1) = IPP(JA+1) + KLOENG(KLAST(JA)) + IF (KLAST(JA+1) == 0) KLAST(JA+1) = KLAST(JA) + IFIRST(JA+1) = KLAST(JA) + KLAST(JA) = KLAST(JA) - 1 + IF (KLAST(JA) == 0) IFIRST(JA) = 0 + LLDONE = .FALSE. + ENDIF + ELSE + IF( IFIRST(JA+1) > 0 )THEN + IF (IPP(JA+1)-IPP(JA) >= IPP(JA) + 2 *& + & KLOENG(IFIRST(JA+1)) -IPP(JA+1) ) THEN + IPP(JA) = IPP(JA) + KLOENG(IFIRST(JA+1)) + IPP(JA+1) = IPP(JA+1) - KLOENG(IFIRST(JA+1)) + KLAST(JA) = IFIRST(JA+1) + IF (IFIRST(JA) == 0) IFIRST(JA) = KLAST(JA) + IF (KLAST(JA+1) == KLAST(JA)) THEN + KLAST(JA+1) = 0 + IFIRST(JA+1) = 0 + ELSE + IFIRST(JA+1) = IFIRST(JA+1) + 1 + ENDIF + LLDONE = .FALSE. + ENDIF + ENDIF + ENDIF + ENDDO + ENDDO + KLAST(KPROCA)=KDGL +ENDIF + +IF (LHOOK) CALL DR_HOOK('SUEMPLATB_MOD:SUEMPLATB',1,ZHOOK_HANDLE) +END SUBROUTINE SUEMPLATB +END MODULE SUEMPLATB_MOD diff --git a/src/etrans/etrans/internal/suestaonl_mod.F90 b/src/etrans/etrans/internal/suestaonl_mod.F90 new file mode 100644 index 000000000..7cd384d53 --- /dev/null +++ b/src/etrans/etrans/internal/suestaonl_mod.F90 @@ -0,0 +1,451 @@ +MODULE SUESTAONL_MOD +CONTAINS +SUBROUTINE SUESTAONL(KMEDIAP,KRESTM,LDWEIGHTED_DISTR,PWEIGHT,PMEDIAP,KPROCAGP) + +!**** *SUESTAONL * - Routine to initialize parallel environment, TAL + +! Purpose. +! -------- +! Initialize D%NSTA and D%NONL. +! Calculation of distribution of grid points to processors : +! Splitting of grid in B direction + +!** Interface. +! ---------- +! *CALL* *SUESTAONL * + +! Explicit arguments : +! -------------------- +! KMEDIAP - mean number of grid points per PE +! KRESTM - number of PEs with one extra point +! LDWEIGHTED_DISTR -true if weighted distribution +! PWEIGHT -weight per grid-point if weighted +! distribution +! PMEDIAP -mean weight per PE if weighted +! distribution +! KPROCAGP -number of grid points per A set +! Implicit arguments : +! -------------------- + +! Method. +! ------- +! See documentation + +! Externals. NONE. +! ---------- + +! Reference. +! ---------- +! ECMWF Research Department documentation of the IFS + +! Author. +! ------- +! MPP Group *ECMWF* + +! Modifications. +! -------------- +! Original : 95-10-01 +! Modified 98-08-10 by K. YESSAD: removal of LRPOLE option. +! - removal of LRPOLE in YOMCT0. +! - removal of code under LRPOLE. +! Modified 98-12-04 C. Fischer: merge with SUESTAONL (Aladin) +! 03-03-03 G. Radnoti: no merge: only difference with +! sustaonl: ezone added to last a-set +! M.Hamrud 01-Oct-2003 CY28 Cleaning +! O.Spaniel Oct-2004 phasing for AL29 +! A.Bogatchev Sep-2010 phasing for AL37 +! R. El Khatib 09-Aug-2013 Allow LEQ_REGIONS +! R. El Khatib 26-Apr-2018 vectorization +! ------------------------------------------------------------------ + +USE PARKIND1 ,ONLY : JPIM ,JPRB +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK +USE MPL_MODULE ,ONLY : MPL_ALLGATHERV, MPL_RECV, MPL_SEND + +USE TPM_GEN ,ONLY : NOUT, NPRINTLEV +USE TPM_DIM ,ONLY : R +USE TPM_GEOMETRY ,ONLY : G +USE TPM_DISTR ,ONLY : D, LEQ_REGIONS, MTAGPART, NPRCIDS, MYPROC, NPROC +USE TPMALD_DIM ,ONLY : RALD +USE SET2PE_MOD ,ONLY : SET2PE +USE EQ_REGIONS_MOD ,ONLY : MY_REGION_EW, MY_REGION_NS, & + & N_REGIONS, N_REGIONS_NS, N_REGIONS_EW +USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS +! + +IMPLICIT NONE + +INTEGER(KIND=JPIM),INTENT(IN) :: KMEDIAP +INTEGER(KIND=JPIM),INTENT(IN) :: KRESTM +REAL(KIND=JPRB),INTENT(IN) :: PWEIGHT(:) +LOGICAL,INTENT(IN) :: LDWEIGHTED_DISTR +REAL(KIND=JPRB),INTENT(IN) :: PMEDIAP +INTEGER(KIND=JPIM),INTENT(IN) :: KPROCAGP(:) + +INTEGER(KIND=JPIM) :: IXPTLAT(R%NDGL), ILSTPTLAT(R%NDGL) +INTEGER(KIND=JPIM) :: ICHK(R%NDLON,R%NDGL), ICOMBUF(R%NDGL*N_REGIONS_EW*2) + +INTEGER(KIND=JPIM) :: I1, I2, IBUFLEN, IDGLG, IDWIDE, & + & IGL, IGL1, IGL2, IGLOFF, IGPTA, & + & IGPTPRSETS, IGPTS, IGPTSP, ILEN, ILRECV, & + & ILSEND, INPLAT, INXLAT, IPOS, & + & IPROCB, IPTSRE, IRECV, & + & IREST, ISEND, ITAG, JA, JB, JGL, JL, JNPTSRE, & + & ILAT, ILON, ILOEN +INTEGER(KIND=JPIM),ALLOCATABLE :: ICOMBUFG(:) +REAL(KIND=JPRB),ALLOCATABLE :: ZWEIGHT(:,:) +INTEGER(KIND=JPIM) :: JJ, ILENG(NPROC), IOFF(NPROC) + +LOGICAL :: LLABORT +LOGICAL :: LLP1,LLP2 + +REAL(KIND=JPRB) :: ZLAT, ZLAT1(R%NDGL), ZCOMP +REAL(KIND=JPRB) :: ZDIVID(R%NDGL),ZXPTLAT(R%NDGL) + +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE +! ----------------------------------------------------------------- + +IF (LHOOK) CALL DR_HOOK('SUESTAONL_MOD:SUESTAONL',0,ZHOOK_HANDLE) +IXPTLAT (:)=999999 +ILSTPTLAT(:)=999999 +LLP1 = NPRINTLEV>0 +LLP2 = NPRINTLEV>1 + +IDWIDE = R%NDGL/2 +IBUFLEN = R%NDGL*N_REGIONS_EW*2 +IDGLG = R%NDGL + +I1 = MAX( 1,D%NFRSTLAT(MY_REGION_NS)-D%NFRSTLOFF) +I2 = MIN(IDGLG,D%NLSTLAT (MY_REGION_NS)-D%NFRSTLOFF) + +ILEN = D%NLSTLAT(MY_REGION_NS) - D%NFRSTLAT(MY_REGION_NS)+1 + +IGPTPRSETS = SUM(G%NLOEN(1:D%NFRSTLAT(MY_REGION_NS)-1)) + + +IF (D%LSPLIT) THEN + IF( LEQ_REGIONS )THEN + IGPTA=0 + DO JA=1,MY_REGION_NS-1 + IGPTA = IGPTA + KPROCAGP(JA) + ENDDO + IGPTS = KPROCAGP(MY_REGION_NS) + ELSE + IF (MY_REGION_NS <= KRESTM.OR.KRESTM == 0) THEN + IF (MY_REGION_NS < N_REGIONS_NS) THEN + IGPTS = KMEDIAP + IGPTA = KMEDIAP*(MY_REGION_NS-1) + ELSE + IGPTS = KMEDIAP+SUM(G%NLOEN(RALD%NDGUX+1:R%NDGL)) + IGPTA = KMEDIAP*(MY_REGION_NS-1) + ENDIF + ELSE + IF (MY_REGION_NS < N_REGIONS_NS) THEN + IGPTS = KMEDIAP-1 + IGPTA = KMEDIAP*KRESTM+IGPTS*(MY_REGION_NS-1-KRESTM) + ELSE + IGPTS = KMEDIAP-1+SUM(G%NLOEN(RALD%NDGUX+1:R%NDGL)) + IGPTA = KMEDIAP*KRESTM+(KMEDIAP-1)*(MY_REGION_NS-1-KRESTM) + ENDIF + ENDIF + ENDIF +ELSE + IGPTA = IGPTPRSETS + IGPTS = SUM(G%NLOEN(D%NFRSTLAT(MY_REGION_NS):D%NLSTLAT(MY_REGION_NS))) +ENDIF +IGPTSP = IGPTS/N_REGIONS(MY_REGION_NS) +IREST = IGPTS-N_REGIONS(MY_REGION_NS)*IGPTSP +IXPTLAT(1) = IGPTA-IGPTPRSETS+1 +ZXPTLAT(1) = REAL(IXPTLAT(1)) +ILSTPTLAT(1) = G%NLOEN(D%NFRSTLAT(MY_REGION_NS)) +INPLAT = G%NLOEN(D%NFRSTLAT(MY_REGION_NS))-IXPTLAT(1)+1 +DO JGL=2,ILEN + IXPTLAT(JGL) = 1 + ZXPTLAT(JGL) = 1.0_JPRB + ILSTPTLAT(JGL) = G%NLOEN(D%NFRSTLAT(MY_REGION_NS)+JGL-1) + INPLAT = INPLAT+G%NLOEN(D%NFRSTLAT(MY_REGION_NS)+JGL-1) +ENDDO +ILSTPTLAT(ILEN) = G%NLOEN(D%NLSTLAT(MY_REGION_NS))-INPLAT+IGPTS + +DO JB=1,N_REGIONS_EW + DO JGL=1,R%NDGL+N_REGIONS_NS-1 + D%NSTA(JGL,JB) = 0 + D%NONL(JGL,JB) = 0 + ENDDO +ENDDO + +! grid point decomposition +! --------------------------------------- +DO JGL=1,ILEN + ZDIVID(JGL)=1._JPRB/REAL(G%NLOEN(D%NFRSTLAT(MY_REGION_NS)+JGL-1),JPRB) +ENDDO +IF( LDWEIGHTED_DISTR )THEN + ALLOCATE(ZWEIGHT(G%NLOEN(R%NDGL/2),R%NDGL)) + IGL=0 + DO JGL=1,R%NDGL + DO JL=1,G%NLOEN(JGL) + IGL=IGL+1 + ZWEIGHT(JL,JGL)=PWEIGHT(IGL) + ENDDO + ENDDO + ZCOMP=0 + IGPTS=0 +ENDIF +DO JB=1,N_REGIONS(MY_REGION_NS) + + IF( .NOT.LDWEIGHTED_DISTR )THEN + + IF (JB <= IREST) THEN + IPTSRE = IGPTSP+1 + ELSE + IPTSRE = IGPTSP + ENDIF + + DO JNPTSRE=1,IPTSRE + ZLAT = 1._JPRB + DO JGL=1,ILEN + ZLAT1(JGL) = (ZXPTLAT(JGL)-1.0_JPRB)*ZDIVID(JGL) + ENDDO + DO JGL=1,ILEN + IF (IXPTLAT(JGL) <= ILSTPTLAT(JGL)) THEN + IF (ZLAT1(JGL) < ZLAT) THEN + ZLAT=ZLAT1(JGL) + INXLAT = JGL + ENDIF + ENDIF + ENDDO + IF (INXLAT >= I1 .AND. INXLAT <= I2) THEN + IGL=D%NPTRFLOFF+INXLAT + IF (D%NSTA(IGL,JB) == 0) THEN + D%NSTA(IGL,JB) = IXPTLAT(INXLAT) + ENDIF + D%NONL(IGL,JB) = D%NONL(IGL,JB)+1 + ENDIF + IXPTLAT(INXLAT) = IXPTLAT(INXLAT)+1 + ZXPTLAT(INXLAT) = REAL(IXPTLAT(INXLAT),JPRB) + ENDDO + + ELSE + DO WHILE ( (JB < N_REGIONS(MY_REGION_NS) .AND. ZCOMP < PMEDIAP) & + & .OR. (JB == N_REGIONS(MY_REGION_NS) .AND. IGPTS < KPROCAGP(MY_REGION_NS)) ) + + IGPTS = IGPTS + 1 + ZLAT = 1._JPRB + DO JGL=1,ILEN + ZLAT1(JGL) = (ZXPTLAT(JGL)-1.0_JPRB)*ZDIVID(JGL) + ENDDO + DO JGL=1,ILEN + IF (IXPTLAT(JGL) <= ILSTPTLAT(JGL)) THEN + IF (ZLAT1(JGL) < ZLAT) THEN + ZLAT = ZLAT1(JGL) + INXLAT = JGL + ENDIF + ENDIF + ENDDO + + IF (INXLAT >= I1 .AND. INXLAT <= I2) THEN + IGL=D%NPTRFLOFF+INXLAT + IF (D%NSTA(IGL,JB) == 0) THEN + D%NSTA(IGL,JB) = IXPTLAT(INXLAT) + ENDIF + D%NONL(IGL,JB) = D%NONL(IGL,JB)+1 + IF(IGL<1.OR.IGL>R%NDGL+N_REGIONS_NS-1)THEN + CALL ABORT_TRANS(' SUSTAONL: IGL<1.OR.IGL>R%NDGL+N_REGIONS_NS-1') + ENDIF + ILON=D%NSTA(IGL,JB)+D%NONL(IGL,JB)-1 + ILAT=D%NFRSTLAT(MY_REGION_NS)+INXLAT-1 + ILOEN=G%NLOEN(ILAT) + IF(ILON<1.OR.ILON>ILOEN)THEN + CALL ABORT_TRANS(' SUSTAONL: ILON<1.OR.ILON>ILOEN') + ENDIF + ZCOMP = ZCOMP + ZWEIGHT(ILON,ILAT) + ENDIF + IXPTLAT(INXLAT) = IXPTLAT(INXLAT)+1 + ZXPTLAT(INXLAT) = REAL(IXPTLAT(INXLAT),JPRB) + ENDDO + + ZCOMP = ZCOMP - PMEDIAP + + ENDIF + +ENDDO + +IF( LDWEIGHTED_DISTR )THEN + DEALLOCATE(ZWEIGHT) +ENDIF +! Exchange local partitioning info to produce global view + +IF( NPROC > 1 )THEN + IF( LEQ_REGIONS )THEN + + ITAG = MTAGPART + IPOS = 0 + DO JGL=1,D%NLSTLAT(MY_REGION_NS)-D%NFRSTLAT(MY_REGION_NS)+1 + IPOS = IPOS+1 + ICOMBUF(IPOS) = D%NSTA(D%NPTRFLOFF+JGL,MY_REGION_EW) + IPOS = IPOS+1 + ICOMBUF(IPOS) = D%NONL(D%NPTRFLOFF+JGL,MY_REGION_EW) + ENDDO + IF( IPOS > IBUFLEN )THEN + CALL ABORT_TRANS(' SUSTAONL: SEND BUFFER TOO SMALL FOR GLOBAL INFO') + ENDIF + ILSEND = IPOS + + DO JA=1,N_REGIONS_NS + DO JB=1,N_REGIONS(JA) + CALL SET2PE(IRECV,JA,JB,0,0) + ILEN = (D%NLSTLAT(JA)-D%NFRSTLAT(JA)+1)*2 + ILENG(NPRCIDS(IRECV))=ILEN + ENDDO + ENDDO + IOFF(1)=0 + DO JJ=2,NPROC + IOFF(JJ)=IOFF(JJ-1)+ILENG(JJ-1) + ENDDO + ALLOCATE(ICOMBUFG(SUM(ILENG(:)))) + CALL MPL_ALLGATHERV(ICOMBUF(1:ILSEND),ICOMBUFG,ILENG,CDSTRING='SUSTAONL') + DO JA=1,N_REGIONS_NS + IGL1 = D%NFRSTLAT(JA) + IGL2 = D%NLSTLAT(JA) + DO JB=1,N_REGIONS(JA) + CALL SET2PE(IRECV,JA,JB,0,0) + IF(IRECV /= MYPROC) THEN + ILEN = (D%NLSTLAT(JA)-D%NFRSTLAT(JA)+1)*2 + IPOS = IOFF(NPRCIDS(IRECV)) + DO JGL=IGL1,IGL2 + IGL = D%NPTRFRSTLAT(JA)+JGL-IGL1 + IPOS = IPOS+1 + D%NSTA(IGL,JB) = ICOMBUFG(IPOS) + IPOS = IPOS+1 + D%NONL(IGL,JB) = ICOMBUFG(IPOS) + ENDDO + ENDIF + ENDDO + ENDDO + DEALLOCATE(ICOMBUFG) + + ELSE + + ITAG = MTAGPART + IPOS = 0 + DO JB=1,N_REGIONS(MY_REGION_NS) + DO JGL=1,D%NLSTLAT(MY_REGION_NS)-D%NFRSTLAT(MY_REGION_NS)+1 + IPOS = IPOS+1 + ICOMBUF(IPOS) = D%NSTA(D%NPTRFLOFF+JGL,JB) + IPOS = IPOS+1 + ICOMBUF(IPOS) = D%NONL(D%NPTRFLOFF+JGL,JB) + ENDDO + ENDDO + IF( IPOS > IBUFLEN )THEN + CALL ABORT_TRANS(' SUESTAONL: SEND BUFFER TOO SMALL FOR GLOBAL INFO') + ENDIF + ILSEND = IPOS + + DO JA=1,N_REGIONS_NS + CALL SET2PE(ISEND,JA,MY_REGION_EW,0,0) + IF(ISEND /= MYPROC) THEN + CALL MPL_SEND(ICOMBUF(1:ILSEND),KDEST=NPRCIDS(ISEND),KTAG=ITAG, & + & CDSTRING='SUESTAONL:') + ENDIF + ENDDO + DO JA=1,N_REGIONS_NS + CALL SET2PE(IRECV,JA,MY_REGION_EW,0,0) + IF(IRECV /= MYPROC) THEN + ILEN = (D%NLSTLAT(JA)-D%NFRSTLAT(JA)+1)*N_REGIONS(JA)*2 + CALL MPL_RECV(ICOMBUF(1:ILEN),KSOURCE=NPRCIDS(IRECV),KTAG=ITAG, & + & KOUNT=ILRECV,CDSTRING='SUESTAONL:') + IGL1 = D%NFRSTLAT(JA) + IGL2 = D%NLSTLAT(JA) + IPOS = 0 + DO JB=1,N_REGIONS(JA) + DO JGL=IGL1,IGL2 + IGL = D%NPTRFRSTLAT(JA)+JGL-IGL1 + IPOS = IPOS+1 + D%NSTA(IGL,JB) = ICOMBUF(IPOS) + IPOS = IPOS+1 + D%NONL(IGL,JB) = ICOMBUF(IPOS) + ENDDO + ENDDO + ENDIF + ENDDO + + ENDIF +ENDIF + +! Confirm consistency of global partitioning, specifically testing for +! multiple assignments of same grid point and unassigned grid points + +LLABORT = .FALSE. +DO JGL=1,R%NDGL + DO JL=1,G%NLOEN(JGL) + ICHK(JL,JGL) = 1 + ENDDO +ENDDO +DO JA=1,N_REGIONS_NS + IGLOFF = D%NPTRFRSTLAT(JA) + DO JB=1,N_REGIONS(JA) + IGL1 = D%NFRSTLAT(JA) + IGL2 = D%NLSTLAT(JA) + DO JGL=IGL1,IGL2 + IGL = IGLOFF+JGL-IGL1 + DO JL=D%NSTA(IGL,JB),D%NSTA(IGL,JB)+D%NONL(IGL,JB)-1 + IF( ICHK(JL,JGL) /= 1 )THEN + WRITE(NOUT,'(" SUESTAONL : seta=",i4," setb=",i4,& + & " row=",I4," sta=",I4," INVALID GRID POINT")')& + & JA,JB,JGL,JL + WRITE(0,'(" SUESTAONL : seta=",i4," setb=",i4,& + & " ROW=",I4," sta=",I4," INVALID GRID POINT")')& + & JA,JB,JGL,JL + LLABORT = .TRUE. + ENDIF + ICHK(JL,JGL) = 2 + ENDDO + ENDDO + ENDDO +ENDDO +DO JGL=1,R%NDGL + DO JL=1,G%NLOEN(JGL) + IF( ICHK(JL,JGL) /= 2 )THEN + WRITE(NOUT,'(" SUESTAONL : row=",i4," sta=",i4,& + & " GRID POINT NOT ASSIGNED")') JGL,JL + LLABORT = .TRUE. + ENDIF + ENDDO +ENDDO +IF( LLABORT )THEN + WRITE(NOUT,'(" SUESTAONL : inconsistent partitioning")') + CALL ABORT_TRANS(' SUESTAONL: inconsistent partitioning') +ENDIF + +IF (LLP1) THEN + WRITE(UNIT=NOUT,FMT='('' OUTPUT FROM ROUTINE SUESTAONL '')') + WRITE(UNIT=NOUT,FMT='('' '')') + WRITE(UNIT=NOUT,FMT='('' PARTITIONING INFORMATION '')') + WRITE(UNIT=NOUT,FMT='('' '')') + IPROCB = MIN(32,N_REGIONS_EW) + WRITE(UNIT=NOUT,FMT='(17X," SETB=",32(1X,I3))') (JB,JB=1,IPROCB) + DO JA=1,N_REGIONS_NS + IPROCB = MIN(32,N_REGIONS(JA)) + WRITE(UNIT=NOUT,FMT='('' '')') + IGLOFF = D%NPTRFRSTLAT(JA) + IGL1 = D%NFRSTLAT(JA) + IGL2 = D%NLSTLAT(JA) + DO JGL=IGL1,IGL2 + IGL=IGLOFF+JGL-IGL1 + WRITE(UNIT=NOUT,FMT='(" SETA=",I3," LAT=",I3," NSTA=",& + & 32(1X,I3))') JA,JGL,(D%NSTA(IGL,JB),JB=1,IPROCB) + WRITE(UNIT=NOUT,FMT='(" SETA=",I3," LAT=",I3," D%NONL=",& + & 32(1X,I3))') JA,JGL,(D%NONL(IGL,JB),JB=1,IPROCB) + WRITE(UNIT=NOUT,FMT='('' '')') + ENDDO + WRITE(UNIT=NOUT,FMT='('' '')') + ENDDO + WRITE(UNIT=NOUT,FMT='('' '')') + WRITE(UNIT=NOUT,FMT='('' '')') +ENDIF +IF (LHOOK) CALL DR_HOOK('SUESTAONL_MOD:SUESTAONL',1,ZHOOK_HANDLE) + +! ------------------------------------------------------------------ + +END SUBROUTINE SUESTAONL +END MODULE SUESTAONL_MOD diff --git a/src/etrans/etrans/internal/tpmald_dim.F90 b/src/etrans/etrans/internal/tpmald_dim.F90 new file mode 100644 index 000000000..716334232 --- /dev/null +++ b/src/etrans/etrans/internal/tpmald_dim.F90 @@ -0,0 +1,23 @@ +MODULE TPMALD_DIM + +! Module for dimensions. + +USE PARKIND1 ,ONLY : JPIM ,JPRB + +IMPLICIT NONE + +SAVE + +TYPE ALDDIM_TYPE + +! COLLOCATION GRID DIMENSIONS + +INTEGER(KIND=JPIM) :: NDGLSUR ! Number of rows of latitudes+... +INTEGER(KIND=JPIM) :: NMSMAX ! Zonal truncation +INTEGER(KIND=JPIM) :: NDGUX ! Number of rows in zone C+I +END TYPE ALDDIM_TYPE + +TYPE(ALDDIM_TYPE),ALLOCATABLE,TARGET :: ALDDIM_RESOL(:) +TYPE(ALDDIM_TYPE),POINTER :: RALD + +END MODULE TPMALD_DIM diff --git a/src/etrans/etrans/internal/tpmald_distr.F90 b/src/etrans/etrans/internal/tpmald_distr.F90 new file mode 100644 index 000000000..9f358db92 --- /dev/null +++ b/src/etrans/etrans/internal/tpmald_distr.F90 @@ -0,0 +1,23 @@ +MODULE TPMALD_DISTR + +! Module for distributed memory environment. + +USE PARKIND1 ,ONLY : JPIM ,JPRB + +IMPLICIT NONE + +SAVE + +TYPE ALDDISTR_TYPE + +INTEGER(KIND=JPIM) ,POINTER :: NESM0(:) ! Address in a spectral array of (m, n=m) +INTEGER(KIND=JPIM) ,POINTER :: NCPL2M(:) ! Number of complex Laplace coefficient for m given +INTEGER(KIND=JPIM) ,POINTER :: NPME(:) ! Address for the Laplace operator and its inverse + +END TYPE ALDDISTR_TYPE + +TYPE(ALDDISTR_TYPE),ALLOCATABLE,TARGET :: ALDDISTR_RESOL(:) +TYPE(ALDDISTR_TYPE),POINTER :: DALD + +END MODULE TPMALD_DISTR + diff --git a/src/etrans/etrans/internal/tpmald_fft.F90 b/src/etrans/etrans/internal/tpmald_fft.F90 new file mode 100644 index 000000000..337dadee6 --- /dev/null +++ b/src/etrans/etrans/internal/tpmald_fft.F90 @@ -0,0 +1,20 @@ +MODULE TPMALD_FFT + +! Module for Fourier transforms. + +USE PARKIND1 ,ONLY : JPIM ,JPRB + +IMPLICIT NONE + +SAVE + +TYPE ALDFFT_TYPE +REAL(KIND=JPRB) ,POINTER :: TRIGSE(:) ! list of trigonometric function values +INTEGER(KIND=JPIM),POINTER :: NFAXE(:) ! list of factors of truncation +LOGICAL :: LFFT992=.TRUE. +END TYPE ALDFFT_TYPE + +TYPE(ALDFFT_TYPE),ALLOCATABLE,TARGET :: ALDFFT_RESOL(:) +TYPE(ALDFFT_TYPE),POINTER :: TALD + +END MODULE TPMALD_FFT diff --git a/src/etrans/etrans/internal/tpmald_fields.F90 b/src/etrans/etrans/internal/tpmald_fields.F90 new file mode 100644 index 000000000..9dfda6db3 --- /dev/null +++ b/src/etrans/etrans/internal/tpmald_fields.F90 @@ -0,0 +1,17 @@ +MODULE TPMALD_FIELDS + +USE PARKIND1 ,ONLY : JPIM ,JPRB + +IMPLICIT NONE + +SAVE + +TYPE ALDFIELDS_TYPE + +REAL(KIND=JPRB) ,POINTER :: RLEPINM(:) ! eigen-values of the inverse Laplace operator +END TYPE ALDFIELDS_TYPE + +TYPE(ALDFIELDS_TYPE),ALLOCATABLE,TARGET :: ALDFIELDS_RESOL(:) +TYPE(ALDFIELDS_TYPE),POINTER :: FALD + +END MODULE TPMALD_FIELDS diff --git a/src/etrans/etrans/internal/tpmald_geo.F90 b/src/etrans/etrans/internal/tpmald_geo.F90 new file mode 100644 index 000000000..326739a16 --- /dev/null +++ b/src/etrans/etrans/internal/tpmald_geo.F90 @@ -0,0 +1,22 @@ +MODULE TPMALD_GEO + +! Module containing data describing plane projection grid. + +USE PARKIND1 ,ONLY : JPIM ,JPRB + +IMPLICIT NONE + +SAVE + +TYPE ALDGEO_TYPE + +! GEOGRAPHY + +REAL(KIND=JPRB) :: EYWN ! Y-reso +REAL(KIND=JPRB) :: EXWN ! X-reso +END TYPE ALDGEO_TYPE + +TYPE(ALDGEO_TYPE),ALLOCATABLE,TARGET :: ALDGEO_RESOL(:) +TYPE(ALDGEO_TYPE),POINTER :: GALD + +END MODULE TPMALD_GEO diff --git a/src/etrans/etrans/internal/tpmald_tcdis.F90 b/src/etrans/etrans/internal/tpmald_tcdis.F90 new file mode 100644 index 000000000..2b57ca50b --- /dev/null +++ b/src/etrans/etrans/internal/tpmald_tcdis.F90 @@ -0,0 +1,13 @@ +MODULE TPMALD_TCDIS + +! useless + +USE PARKIND1 ,ONLY : JPIM ,JPRB + +IMPLICIT NONE + +SAVE + +REAL(KIND=JPRB) :: TCDIS + +END MODULE TPMALD_TCDIS diff --git a/src/programs/CMakeLists.txt b/src/programs/CMakeLists.txt index b7cdc1ff3..19b19f388 100644 --- a/src/programs/CMakeLists.txt +++ b/src/programs/CMakeLists.txt @@ -39,6 +39,15 @@ foreach( prec sp dp ) parkind_${prec} trans_${prec} ) + if ( HAVE_ETRANS ) + ecbuild_add_executable(TARGET ectrans-lam-benchmark-${prec} + SOURCES ectrans-lam-benchmark.F90 + LIBS + fiat + parkind_${prec} + trans_${prec} + ) + endif() endif() endforeach() diff --git a/src/programs/ectrans-lam-benchmark.F90 b/src/programs/ectrans-lam-benchmark.F90 new file mode 100644 index 000000000..da066ae76 --- /dev/null +++ b/src/programs/ectrans-lam-benchmark.F90 @@ -0,0 +1,1479 @@ +program ectrans_lam_benchmark + +! +! Spectral transform test for Limited-Area geometry +! +! This test performs spectral to real and real to spectral transforms repeated in +! timed loop. +! +! 1) One "surface" field is always transformed: +! zspsc2(1,1:nspec2) <-> zgmvs(1:nproma,1:1,1:ngbplk) +! +! 2) A Multiple "3d" fields are transformed and can be disabled with "--nfld 0" +! +! zspsc3a(1:nlev,1:nspec2,1:nfld) <-> zgp3a(1:nproma,1:nlev,1:nfld,1:ngpblk) +! +! 3) Optionally a "3d" vorticity/divergence field is transformed to uv (wind) and +! can be enabled with "--vordiv" +! +! zspvor(1:nlev,1:nspec2) / zspdiv(1:nlev,1:nspec2) <-> zgpuv(1:nproma,1:nlev,1:2,1:ngpblk) +! +! 4) Optionally scalar derivatives can be computed for the fields described in 1) and 2) +! This must be enabled with "--scders" +! +! 5) Optionally uv East-West derivate can be computed from vorticity/divergence. +! This must be enabled with "--vordiv --uvders" +! +! +! Authors : George Mozdzynski +! Willem Deconinck +! Ioan Hadade +! Sam Hatfield +! Daan Degrauwe + +use parkind1, only: jpim, jprb, jprd +use oml_mod ,only : oml_max_threads +use omp_lib, only: omp_get_wtime +use mpl_module +use yomgstats, only: jpmaxstat +use yomhook, only : dr_hook_init + +implicit none + +integer(kind=jpim) :: istack, getstackusage +real(kind=jprb), dimension(1) :: zmaxerr(5), zerr(5) +real(kind=jprb) :: zmaxerrg + +! Output unit numbers +integer(kind=jpim), parameter :: nerr = 0 ! Unit number for STDERR +integer(kind=jpim), parameter :: nout = 6 ! Unit number for STDOUT +integer(kind=jpim), parameter :: noutdump = 7 ! Unit number for field output + +! Default parameters +integer(kind=jpim) :: nlon = 128 ! Zonal dimension +integer(kind=jpim) :: nlat = 128 ! Meridional dimension +integer(kind=jpim) :: nsmax = 0 ! Spectral meridional truncation +integer(kind=jpim) :: nmsmax = 0 ! Spectral zonal truncation +integer(kind=jpim) :: iters = 10 ! Number of iterations for transform test +integer(kind=jpim) :: nfld = 1 ! Number of scalar fields +integer(kind=jpim) :: nlev = 1 ! Number of vertical levels + +integer(kind=jpim) :: nloen(1) ! only one value needed for LAM +integer(kind=jpim) :: nflevg +integer(kind=jpim) :: nspec2 +integer(kind=jpim) :: ngptot +integer(kind=jpim) :: ngptotg +integer(kind=jpim) :: ifld +integer(kind=jpim) :: jroc +integer(kind=jpim) :: jb +integer(kind=jpim) :: nspec2g +integer(kind=jpim) :: i +integer(kind=jpim) :: ja +integer(kind=jpim) :: ib +integer(kind=jpim) :: jprtrv + +integer(kind=jpim), allocatable :: nprcids(:) +integer(kind=jpim) :: myproc, jj +integer :: jstep + +real(kind=jprd) :: ztinit, ztloop, ztstepmax, ztstepmin, ztstepavg, ztstepmed +real(kind=jprd) :: ztstepmax1, ztstepmin1, ztstepavg1, ztstepmed1 +real(kind=jprd) :: ztstepmax2, ztstepmin2, ztstepavg2, ztstepmed2 +real(kind=jprd), allocatable :: ztstep(:), ztstep1(:), ztstep2(:) + +real(kind=jprb), allocatable :: znormsp(:), znormsp0(:), znormdiv(:), znormdiv0(:) +real(kind=jprb), allocatable :: znormvor(:), znormvor0(:), znormt(:), znormt0(:) +real(kind=jprd) :: zaveave(0:jpmaxstat) + +! Grid-point space data structures +real(kind=jprb), allocatable, target :: zgmv (:,:,:,:) ! Multilevel fields at t and t-dt +real(kind=jprb), allocatable, target :: zgmvs (:,:,:) ! Single level fields at t and t-dt +real(kind=jprb), pointer :: zgp3a (:,:,:,:) ! Multilevel fields at t and t-dt +real(kind=jprb), pointer :: zgpuv (:,:,:,:) ! Multilevel fields at t and t-dt +real(kind=jprb), pointer :: zgp2 (:,:,:) ! Single level fields at t and t-dt + +! Spectral space data structures +real(kind=jprb), allocatable, target :: sp3d(:,:,:) +real(kind=jprb), pointer :: zspvor(:,:) => null() +real(kind=jprb), pointer :: zspdiv(:,:) => null() +real(kind=jprb), pointer :: zspsc3a(:,:,:) => null() +real(kind=jprb), allocatable :: zspsc2(:,:) +real(kind=jprb), allocatable :: zmeanu(:), zmeanv(:) + +logical :: lstack = .false. ! Output stack info +logical :: luserpnm = .false. +logical :: lkeeprpnm = .false. +logical :: ltrace_stats = .false. +logical :: lstats_omp = .false. +logical :: lstats_comms = .false. +logical :: lstats_mpl = .false. +logical :: lstats = .false. ! gstats statistics +logical :: lbarrier_stats = .false. +logical :: lbarrier_stats2 = .false. +logical :: ldetailed_stats = .false. +logical :: lstats_alloc = .false. +logical :: lsyncstats = .false. +logical :: lstatscpu = .false. +logical :: lstats_mem = .false. +logical :: lxml_stats = .false. +logical :: lfftw = .false. ! Use FFTW for Fourier transforms +logical :: lvordiv = .false. +logical :: lscders = .false. +logical :: luvders = .false. +logical :: lprint_norms = .false. ! Calculate and print spectral norms +logical :: lmeminfo = .false. ! Show information from FIAT routine ec_meminfo at the end + +integer(kind=jpim) :: nstats_mem = 0 +integer(kind=jpim) :: ntrace_stats = 0 +integer(kind=jpim) :: nprnt_stats = 1 + +! The multiplier of the machine epsilon used as a tolerance for correctness checking +! ncheck = 0 (the default) means that correctness checking is disabled +integer(kind=jpim) :: ncheck = 0 + +logical :: lmpoff = .false. ! Message passing switch + +! Verbosity level (0 or 1) +integer :: verbosity = 0 + +integer(kind=jpim) :: nmax_resol = 37 ! Max number of resolutions +integer(kind=jpim) :: npromatr = 0 ! nproma for trans lib +integer(kind=jpim) :: ncombflen = 1800000 ! Size of comm buffer + +integer(kind=jpim) :: nproc ! Number of procs +integer(kind=jpim) :: nthread +integer(kind=jpim) :: nprgpns = 0 ! Grid-point decomp +integer(kind=jpim) :: nprgpew = 0 ! Grid-point decomp +integer(kind=jpim) :: nprtrv = 0 ! Spectral decomp +integer(kind=jpim) :: nprtrw = 0 ! Spectral decomp +integer(kind=jpim) :: nspecresmin = 80 ! Minimum spectral resolution, for controlling nprtrw +integer(kind=jpim) :: mysetv +integer(kind=jpim) :: mysetw +integer(kind=jpim) :: mp_type = 2 ! Message passing type +integer(kind=jpim) :: mbx_size = 150000000 ! Mailbox size + +integer(kind=jpim), allocatable :: numll(:), ivset(:) +integer(kind=jpim) :: ivsetsc(1) + +integer(kind=jpim) :: nflevl + +! sumpini +integer(kind=jpim) :: isqr +logical :: lsync_trans = .false. ! Activate barrier sync + + +integer(kind=jpim) :: nproma = 0 +integer(kind=jpim) :: ngpblks +! locals +integer(kind=jpim) :: iprtrv +integer(kind=jpim) :: iprtrw +integer(kind=jpim) :: iprused, ilevpp, irest, ilev, jlev + +integer(kind=jpim) :: ndimgmv = 0 ! Third dim. of gmv "(nproma,nflevg,ndimgmv,ngpblks)" +integer(kind=jpim) :: ndimgmvs = 0 ! Second dim. gmvs "(nproma,ndimgmvs,ngpblks)" + +integer(kind=jpim) :: jbegin_uv = 0 +integer(kind=jpim) :: jend_uv = 0 +integer(kind=jpim) :: jbegin_sc = 0 +integer(kind=jpim) :: jend_sc = 0 +integer(kind=jpim) :: jbegin_scder_NS = 0 +integer(kind=jpim) :: jend_scder_NS = 0 +integer(kind=jpim) :: jbegin_scder_EW = 0 +integer(kind=jpim) :: jend_scder_EW = 0 +integer(kind=jpim) :: jbegin_uder_EW = 0 +integer(kind=jpim) :: jend_uder_EW = 0 +integer(kind=jpim) :: jbegin_vder_EW = 0 +integer(kind=jpim) :: jend_vder_EW = 0 + +logical :: ldump_values = .false. + +integer, external :: ec_mpirank +logical :: luse_mpi = .true. + +real(kind=jprb) :: zexwn, zeywn + +!=================================================================================================== + +#include "setup_trans0.h" +#include "esetup_trans.h" +#include "einv_trans.h" +#include "edir_trans.h" +#include "etrans_inq.h" +#include "especnorm.h" +#include "abor1.intfb.h" +#include "gstats_setup.intfb.h" +#include "ec_meminfo.intfb.h" + +!=================================================================================================== + +luse_mpi = detect_mpirun() + +! Setup +call get_command_line_arguments(nlon, nlat, nsmax, nmsmax, iters, nfld, nlev, lvordiv, lscders, luvders, & + & nproma, verbosity, ldump_values, lprint_norms, lmeminfo, nprgpns, nprgpew, nprtrv, nprtrw, ncheck) +! derived defaults +if ( nsmax == 0 ) nsmax = nlat/2-1 +if ( nmsmax == 0 ) nmsmax = nlon/2-1 +nflevg = nlev + +!=================================================================================================== + +if (luse_mpi) then + call mpl_init(ldinfo=(verbosity>=1)) + nproc = mpl_nproc() + myproc = mpl_myrank() +else + nproc = 1 + myproc = 1 + mpl_comm = -1 +endif +nthread = oml_max_threads() + +call dr_hook_init() + +!=================================================================================================== + +if( lstats ) call gstats(0,0) +ztinit = omp_get_wtime() + +! only output to stdout on pe 1 +!if (nproc > 1) then + !if (myproc /= 1) then + !open(unit=nout, file='output_'//char(myproc/10+48)//char(myproc+48)//'.dat') + !endif +!endif + +if (ldetailed_stats) then + lstats_omp = .true. + lstats_comms = .true. + lstats_mpl = .true. + lstatscpu = .true. + nprnt_stats = nproc + lstats_mem = .true. + lstats_alloc = .true. +endif + +!=================================================================================================== + +allocate(nprcids(nproc)) +do jj = 1, nproc + nprcids(jj) = jj +enddo + +if (nproc <= 1) then + lmpoff = .true. +endif + +! Compute nprgpns and nprgpew +! This version selects most square-like distribution +if (nproc == 0) nproc = 1 +if ( nprgpew == 0 .and. nprgpns == 0 ) then + isqr = int(sqrt(real(nproc,jprb))) + do ja = isqr, nproc + ib = nproc/ja + if (ja*ib == nproc) then + nprgpns = max(ja,ib) + nprgpew = min(ja,ib) + exit + endif + enddo +elseif (nprgpns == 0 ) then + nprgpns=nproc/nprgpew +elseif (nprgpew == 0 ) then + nprgpew=nproc/nprgpns +endif +if (nprgpns*nprgpew /= nproc) call abor1('transform_test:nprgpns*nprgpew /= nproc') + +! From sumpini, although this should be specified in namelist +if (nspecresmin == 0) nspecresmin = nproc + +! Compute nprtrv and nprtrw if not provided on the command line +if (nprtrv ==0 .and. nprtrw == 0 ) then + nprtrv=nprgpew + nprtrw=nprgpns +elseif (nprtrv == 0 ) then + nprtrv=nproc/nprtrw +elseif (nprtrw == 0 ) then + nprtrw=nproc/nprtrv +endif +if (nprtrv*nprtrw /= nproc) call abor1('transform_test:nprtrv*nprtrw /= nproc') + +mysetv=mod(myproc-1,nprtrv)+1 + +! Determine number of local levels for zonal and meridional fourier calculations +! based on the values of nflevg and nprtrv +allocate(numll(nprtrv)) +numll=nflevg/nprtrv +numll(1:modulo(nflevg,nprtrv))=numll(1:modulo(nflevg,nprtrv))+1 +ivsetsc(1)=min(nflevg+1, nprtrv) +nflevl = numll(mysetv) + +!=================================================================================================== +! Setup gstats +!=================================================================================================== + +if (lstats) then + call gstats_setup(nproc, myproc, nprcids, & + & lstats, lstatscpu, lsyncstats, ldetailed_stats, lbarrier_stats, lbarrier_stats2, & + & lstats_omp, lstats_comms, lstats_mem, nstats_mem, lstats_alloc, & + & ltrace_stats, ntrace_stats, nprnt_stats, lxml_stats) + call gstats_psut + + ! Assign labels to GSTATS regions + call gstats_labels +endif + +!=================================================================================================== +! Call ecTrans setup routines +!=================================================================================================== + +if (verbosity >= 1) write(nout,'(a)')'======= Setup ecTrans =======' + +if( lstats ) call gstats(1, 0) +call setup_trans0(kout=nout, kerr=nerr, kprintlev=merge(2, 0, verbosity == 1), & + & kmax_resol=nmax_resol, kpromatr=0, kprgpns=nprgpns, kprgpew=nprgpew, & + & kprtrw=nprtrw, kcombflen=ncombflen, ldsync_trans=lsync_trans, & + & ldalloperm=.true., ldmpoff=.not.luse_mpi) + if( lstats ) call gstats(1, 1) + + if( lstats ) call gstats(2, 0) +zexwn=1._jprb ! 2*pi/(nx*dx): spectral resolution +zeywn=1._jprb ! 2*pi/(ny*dy) +nloen=nlon +call esetup_trans(ksmax=nsmax, kmsmax=nmsmax, kdgl=nlat, kdgux=nlat, kloen=nloen, ldsplit=.true., & + & ldusefftw=lfftw,pexwn=zexwn,peywn=zeywn) + + if( lstats ) call gstats(2, 1) + +call etrans_inq(kspec2=nspec2, kspec2g=nspec2g, kgptot=ngptot, kgptotg=ngptotg) + +if (nproma == 0) then ! no blocking (default when not specified) + nproma = ngptot +endif + +! Calculate number of NPROMA blocks +ngpblks = (ngptot - 1)/nproma+1 + +!=================================================================================================== +! Print information before starting +!=================================================================================================== + +! Print configuration details +if (verbosity >= 0) then + write(nout,'(" ")') + write(nout,'(a)')'======= Start of runtime parameters =======' + write(nout,'(" ")') + write(nout,'("nlon ",i0)') nlon + write(nout,'("nlat ",i0)') nlat + write(nout,'("nsmax ",i0)') nsmax + write(nout,'("nmsmax ",i0)') nmsmax + write(nout,'("nproc ",i0)') nproc + write(nout,'("nthread ",i0)') nthread + write(nout,'("nprgpns ",i0)') nprgpns + write(nout,'("nprgpew ",i0)') nprgpew + write(nout,'("nprtrw ",i0)') nprtrw + write(nout,'("nprtrv ",i0)') nprtrv + write(nout,'("ngptot ",i0)') ngptot + write(nout,'("ngptotg ",i0)') ngptotg + write(nout,'("nfld ",i0)') nfld + write(nout,'("nlev ",i0)') nlev + write(nout,'("nflevl ",i0)') nflevl + write(nout,'("nproma ",i0)') nproma + write(nout,'("ngpblks ",i0)') ngpblks + write(nout,'("nspec2 ",i0)') nspec2 + write(nout,'("nspec2g ",i0)') nspec2g + write(nout,'("lvordiv ",l)') lvordiv + write(nout,'("lscders ",l)') lscders + write(nout,'("luvders ",l)') luvders + write(nout,'(" ")') + write(nout,'(a)') '======= End of runtime parameters =======' + write(nout,'(" ")') +end if + +!=================================================================================================== +! Allocate and Initialize spectral arrays +!=================================================================================================== + +! Allocate spectral arrays +! Try to mimick IFS layout as much as possible +nullify(zspvor) +nullify(zspdiv) +nullify(zspsc3a) +allocate(sp3d(nflevl,nspec2,2+nfld)) +allocate(zspsc2(1,nspec2)) +allocate(zmeanu(nflevl),zmeanv(nflevl)) +zmeanu(:)=0._jprb +zmeanv(:)=0._jprb + +call initialize_spectral_arrays(nsmax, nmsmax, zspsc2, sp3d) + +! Point convenience variables to storage variable sp3d +zspvor => sp3d(:,:,1) +zspdiv => sp3d(:,:,2) +zspsc3a => sp3d(:,:,3:3+(nfld-1)) + +!=================================================================================================== +! Allocate gridpoint arrays +!=================================================================================================== + +allocate(ivset(nflevg)) + +! Compute spectral distribution +ilev = 0 +do jb = 1, nprtrv + do jlev=1, numll(jb) + ilev = ilev + 1 + ivset(ilev) = jb + enddo +enddo + +! Allocate grid-point arrays +if (lvordiv) then + jbegin_uv = 1 + jend_uv = 2 +endif +if (luvders) then + jbegin_uder_EW = jend_uv + 1 + jend_uder_EW = jbegin_uder_EW + 1 + jbegin_vder_EW = jend_uder_EW + 1 + jend_vder_EW = jbegin_vder_EW + 1 +else + jbegin_uder_EW = jend_uv + jend_uder_EW = jend_uv + jbegin_vder_EW = jend_uv + jend_vder_EW = jend_uv +endif + +jbegin_sc = jend_vder_EW + 1 +jend_sc = jend_vder_EW + nfld + +if (lscders) then + ndimgmvs = 3 + jbegin_scder_NS = jend_sc + 1 + jend_scder_NS = jend_sc + nfld + jbegin_scder_EW = jend_scder_NS + 1 + jend_scder_EW = jend_scder_NS + nfld +else + ndimgmvs = 1 + jbegin_scder_NS = jend_sc + jend_scder_NS = jend_sc + jbegin_scder_EW = jend_sc + jend_scder_EW = jend_sc +endif + +ndimgmv = jend_scder_EW + +!allocate(zgmv(nproma,nflevg,ndimgmv,ngpblks)) +!allocate(zgmvs(nproma,ndimgmvs,ngpblks)) +!zgpuv => zgmv(:,:,1:jend_vder_EW,:) +!zgp3a => zgmv(:,:,jbegin_sc:jend_scder_EW,:) +!zgp2 => zgmvs(:,:,:) + +! allocate separately since non-contiguous host-device transfers are not supported. +allocate(zgpuv(nproma,nflevg,jend_vder_EW,ngpblks)) +allocate(zgp3a(nproma,nflevg,jend_scder_EW-jbegin_sc+1,ngpblks)) +allocate(zgp2(nproma,ndimgmvs,ngpblks)) + +zgp2=0. +zgp3a=0. +zgpuv=0. + +!=================================================================================================== +! Allocate norm arrays +!=================================================================================================== + +if (lprint_norms .or. ncheck > 0) then + allocate(znormsp(1)) + allocate(znormsp0(1)) + allocate(znormvor(nflevg)) + allocate(znormvor0(nflevg)) + allocate(znormdiv(nflevg)) + allocate(znormdiv0(nflevg)) + allocate(znormt(nflevg)) + allocate(znormt0(nflevg)) + + call especnorm(pspec=zspvor(1:nflevl,:), pnorm=znormvor0, kvset=ivset(1:nflevg)) + call especnorm(pspec=zspdiv(1:nflevl,:), pnorm=znormdiv0, kvset=ivset(1:nflevg)) + call especnorm(pspec=zspsc3a(1:nflevl,:,1), pnorm=znormt0, kvset=ivset(1:nflevg)) + call especnorm(pspec=zspsc2(1:1,:), pnorm=znormsp0, kvset=ivsetsc) + + if (verbosity >= 1 .and. myproc == 1) then + do ifld = 1, nflevg + write(nout,'("norm zspvor( ",i4,",:) = ",f20.15)') ifld, znormvor0(ifld) + enddo + do ifld = 1, nflevg + write(nout,'("norm zspdiv( ",i4,",:) = ",f20.15)') ifld, znormdiv0(ifld) + enddo + do ifld = 1, nflevg + write(nout,'("norm zspsc3a(",i4,",:,1) = ",f20.15)') ifld, znormt0(ifld) + enddo + do ifld = 1, 1 + write(nout,'("norm zspsc2( ",i4,",:) = ",f20.15)') ifld, znormsp0(ifld) + enddo + endif +endif + +!=================================================================================================== +! Setup timers +!=================================================================================================== + +ztinit = (omp_get_wtime() - ztinit) + +if (verbosity >= 0) then + write(nout,'(" ")') + write(nout,'(a,i6,a,f9.2,a)') "transform_test initialisation, on",nproc,& + & " tasks, took",ztinit," sec" + write(nout,'(" ")') +endif + +if (iters <= 0) call abor1('transform_test:iters <= 0') + +allocate(ztstep(iters)) +allocate(ztstep1(iters)) +allocate(ztstep2(iters)) + +ztstepavg = 0._jprd +ztstepmax = 0._jprd +ztstepmin = 9999999999999999._jprd +ztstepavg1 = 0._jprd +ztstepmax1 = 0._jprd +ztstepmin1 = 9999999999999999._jprd +ztstepavg2 = 0._jprd +ztstepmax2 = 0._jprd +ztstepmin2 = 9999999999999999._jprd + +!================================================================================================= +! Dump the values to disk, for debugging only +!================================================================================================= + +if (ldump_values) then + ! dump a field to a binary file + call dump_spectral_field(jstep, myproc, nspec2, nsmax, nmsmax, zspsc2(1,:),ivsetsc(1:1), 'S', noutdump) + if (lvordiv) then + call dump_spectral_field(jstep, myproc, nspec2, nsmax, nmsmax, zspdiv(1,:),ivset(1:1), 'D', noutdump) + call dump_spectral_field(jstep, myproc, nspec2, nsmax, nmsmax, zspvor(1,:),ivset(1:1), 'V', noutdump) + endif + call dump_spectral_field(jstep, myproc, nspec2, nsmax, nmsmax, zspsc3a(1,:,1),ivset(1:1), 'T', noutdump) +endif + +write(nout,'(a)') '======= Start of spectral transforms =======' +write(nout,'(" ")') + +ztloop = omp_get_wtime() + +!=================================================================================================== +! Do spectral transform loop +!=================================================================================================== + +do jstep = 1, iters + if( lstats ) call gstats(3,0) + ztstep(jstep) = omp_get_wtime() + + !================================================================================================= + ! Do inverse transform + !================================================================================================= + + ztstep1(jstep) = omp_get_wtime() + if( lstats ) call gstats(4,0) + if (lvordiv) then + + call einv_trans(kresol=1, kproma=nproma, & + & pspsc2=zspsc2, & ! spectral surface pressure + & pspvor=zspvor, & ! spectral vorticity + & pspdiv=zspdiv, & ! spectral divergence + & pspsc3a=zspsc3a, & ! spectral scalars + & ldscders=lscders, & + & ldvorgp=.false., & ! no gridpoint vorticity + & lddivgp=.false., & ! no gridpoint divergence + & lduvder=luvders, & + & kvsetuv=ivset, & + & kvsetsc2=ivsetsc, & + & kvsetsc3a=ivset, & + & pgp2=zgp2, & + & pgpuv=zgpuv, & + & pgp3a=zgp3a, & + & pmeanu=zmeanu, & + & pmeanv=zmeanv) + + else + + call einv_trans(kresol=1, kproma=nproma, & + & pspsc2=zspsc2, & ! spectral surface pressure + & pspsc3a=zspsc3a, & ! spectral scalars + & ldscders=lscders, & ! scalar derivatives + & kvsetsc2=ivsetsc, & + & kvsetsc3a=ivset, & + & pgp2=zgp2, & + & pgp3a=zgp3a) + + endif + + if( lstats ) call gstats(4,1) + + ztstep1(jstep) = (omp_get_wtime() - ztstep1(jstep)) + + !================================================================================================= + ! While in grid point space, dump the values to disk, for debugging only + !================================================================================================= + + if (ldump_values) then + ! dump a field to a binary file + call dump_gridpoint_field(jstep, myproc, nlat, nproma, ngpblks, zgp2(:,1,:), 'S', noutdump) + if (lvordiv) then + call dump_gridpoint_field(jstep, myproc, nlat, nproma, ngpblks, zgpuv(:,nflevg,1,:), 'U', noutdump) + call dump_gridpoint_field(jstep, myproc, nlat, nproma, ngpblks, zgpuv(:,nflevg,2,:), 'V', noutdump) + endif + call dump_gridpoint_field(jstep, myproc, nlat, nproma, ngpblks, zgp3a(:,nflevg,1,:), 'T', noutdump) + endif + + !================================================================================================= + ! Do direct transform + !================================================================================================= + + ztstep2(jstep) = omp_get_wtime() + + if( lstats ) call gstats(5,0) + + + if (lvordiv) then + call edir_trans(kresol=1, kproma=nproma, & + & pgp2=zgp2(:,1:1,:), & + & pgpuv=zgpuv(:,:,1:2,:), & + & pgp3a=zgp3a(:,:,1:nfld,:), & + & pspvor=zspvor, & + & pspdiv=zspdiv, & + & pspsc2=zspsc2, & + & pspsc3a=zspsc3a, & + & kvsetuv=ivset, & + & kvsetsc2=ivsetsc, & + & kvsetsc3a=ivset, & + & pmeanu=zmeanu, & + & pmeanv=zmeanv) + else + + call edir_trans(kresol=1, kproma=nproma, & + & pgp2=zgp2(:,1:1,:), & + & pgp3a=zgp3a(:,:,1:nfld,:), & + & pspsc2=zspsc2, & + & pspsc3a=zspsc3a, & + & kvsetsc2=ivsetsc, & + & kvsetsc3a=ivset) + endif + if( lstats ) call gstats(5,1) + ztstep2(jstep) = (omp_get_wtime() - ztstep2(jstep)) + + !================================================================================================= + ! Dump the values to disk, for debugging only + !================================================================================================= + + if (ldump_values) then + ! dump a field to a binary file + call dump_spectral_field(jstep, myproc, nspec2, nsmax, nmsmax, zspsc2(1,:),ivsetsc(1:1), 'S', noutdump) + if (lvordiv) then + call dump_spectral_field(jstep, myproc, nspec2, nsmax, nmsmax, zspdiv(1,:),ivset(1), 'D', noutdump) + call dump_spectral_field(jstep, myproc, nspec2, nsmax, nmsmax, zspvor(1,:),ivset(1:1), 'V', noutdump) + endif + call dump_spectral_field(jstep, myproc, nspec2, nsmax, nmsmax, zspsc3a(1,:,1),ivset(1:1), 'T', noutdump) + endif + + !================================================================================================= + ! Calculate timings + !================================================================================================= + + ztstep(jstep) = (omp_get_wtime() - ztstep(jstep)) + + ztstepavg = ztstepavg + ztstep(jstep) + ztstepmin = min(ztstep(jstep), ztstepmin) + ztstepmax = max(ztstep(jstep), ztstepmax) + + ztstepavg1 = ztstepavg1 + ztstep1(jstep) + ztstepmin1 = min(ztstep1(jstep), ztstepmin1) + ztstepmax1 = max(ztstep1(jstep), ztstepmax1) + + ztstepavg2 = ztstepavg2 + ztstep2(jstep) + ztstepmin2 = min(ztstep2(jstep), ztstepmin2) + ztstepmax2 = max(ztstep2(jstep), ztstepmax2) + + !================================================================================================= + ! Print norms + !================================================================================================= + + if (lprint_norms) then + if( lstats ) call gstats(6,0) + call especnorm(pspec=zspsc2(1:1,:), pnorm=znormsp, kvset=ivsetsc(1:1)) + call especnorm(pspec=zspvor(1:nflevl,:), pnorm=znormvor, kvset=ivset(1:nflevg)) + call especnorm(pspec=zspdiv(1:nflevl,:), pnorm=znormdiv, kvset=ivset(1:nflevg)) + call especnorm(pspec=zspsc3a(1:nflevl,:,1), pnorm=znormt, kvset=ivset(1:nflevg)) + + if ( myproc == 1 ) then + + ! Surface pressure + zmaxerr(:) = -999.0 + do ifld = 1, 1 + zerr(1) = abs(znormsp(ifld)/znormsp0(ifld) - 1.0_jprb) + zmaxerr(1) = max(zmaxerr(1), zerr(1)) + enddo + ! Divergence + do ifld = 1, nflevg + zerr(2) = abs(znormdiv(ifld)/znormdiv0(ifld) - 1.0_jprb) + zmaxerr(2) = max(zmaxerr(2), zerr(2)) + enddo + ! Vorticity + do ifld = 1, nflevg + zerr(3) = abs(znormvor(ifld)/znormvor0(ifld) - 1.0_jprb) + zmaxerr(3) = max(zmaxerr(3),zerr(3)) + enddo + ! Temperature + do ifld = 1, nflevg + zerr(4) = abs(znormt(ifld)/znormt0(ifld) - 1.0_jprb) + zmaxerr(4) = max(zmaxerr(4), zerr(4)) + enddo + write(nout,'("time step ",i6," took", f8.4," | zspvor max err="e10.3,& + & " | zspdiv max err="e10.3," | zspsc3a max err="e10.3," | zspsc2 max err="e10.3)') & + & jstep, ztstep(jstep), zmaxerr(3), zmaxerr(2), zmaxerr(4), zmaxerr(1) + if( lstats )call gstats(6,1) + else + write(nout,'("Time step ",i6," took", f8.4)') jstep, ztstep(jstep) + endif + + endif + + if( lstats ) call gstats(3,1) + +enddo + +!=================================================================================================== + +ztloop = (omp_get_wtime() - ztloop) + +write(nout,'(" ")') +write(nout,'(a)') '======= End of spectral transforms =======' +write(nout,'(" ")') + +if (lprint_norms .or. ncheck > 0) then + call especnorm(pspec=zspvor(1:nflevl,:), pnorm=znormvor, kvset=ivset) + call especnorm(pspec=zspdiv(1:nflevl,:), pnorm=znormdiv, kvset=ivset) + call especnorm(pspec=zspsc3a(1:nflevl,:,1), pnorm=znormt, kvset=ivset) + call especnorm(pspec=zspsc2(1:1,:), pnorm=znormsp, kvset=ivsetsc) + + if ( myproc == 1 ) then + + zmaxerr(:) = -999.0 + do ifld = 1, nflevg + zerr(3) = abs(real(znormvor(ifld),kind=jprd)/real(znormvor0(ifld),kind=jprd) - 1.0_jprd) + zmaxerr(3) = max(zmaxerr(3), zerr(3)) + if (verbosity >= 1) then + write(nout,'("norm zspvor( ",i4,") = ",f20.15," error = ",e10.3)') ifld, znormvor0(ifld), zerr(3) + endif + enddo + do ifld = 1, nflevg + zerr(2) = abs(real(znormdiv(ifld),kind=jprd)/real(znormdiv0(ifld),kind=jprd) - 1.0d0) + zmaxerr(2) = max(zmaxerr(2),zerr(2)) + if (verbosity >= 1) then + write(nout,'("norm zspdiv( ",i4,",:) = ",f20.15," error = ",e10.3)') ifld, znormdiv0(ifld), zerr(2) + endif + enddo + do ifld = 1, nflevg + zerr(4) = abs(real(znormt(ifld),kind=jprd)/real(znormt0(ifld),kind=jprd) - 1.0d0) + zmaxerr(4) = max(zmaxerr(4), zerr(4)) + if (verbosity >= 1) then + write(nout,'("norm zspsc3a(",i4,",:,1) = ",f20.15," error = ",e10.3)') ifld, znormt0(ifld), zerr(4) + endif + enddo + do ifld = 1, 1 + zerr(1) = abs(real(znormsp(ifld),kind=jprd)/real(znormsp0(ifld),kind=jprd) - 1.0d0) + zmaxerr(1) = max(zmaxerr(1), zerr(1)) + if (verbosity >= 1) then + write(nout,'("norm zspsc2( ",i4,",:) = ",f20.15," error = ",e10.3)') ifld, znormsp0(ifld), zerr(1) + endif + enddo + + ! maximum error across all fields + zmaxerrg = max(max(zmaxerr(1),zmaxerr(2)), max(zmaxerr(2), zmaxerr(3))) + + if (verbosity >= 1) write(nout,*) + write(nout,'("max error zspvor(1:nlev,:) = ",e10.3)') zmaxerr(3) + write(nout,'("max error zspdiv(1:nlev,:) = ",e10.3)') zmaxerr(2) + write(nout,'("max error zspsc3a(1:nlev,:,1) = ",e10.3)') zmaxerr(4) + write(nout,'("max error zspsc2(1:1,:) = ",e10.3)') zmaxerr(1) + write(nout,*) + write(nout,'("max error combined = = ",e10.3)') zmaxerrg + write(nout,*) + + if (ncheck > 0) then + ! If the maximum spectral norm error across all fields is greater than 100 times the machine + ! epsilon, fail the test + if (zmaxerrg > real(ncheck, jprb) * epsilon(1.0_jprb)) then + write(nout, '(a)') '*******************************' + write(nout, '(a)') 'Correctness test failed' + write(nout, '(a,1e7.2)') 'Maximum spectral norm error = ', zmaxerrg + write(nout, '(a,1e7.2)') 'Error tolerance = ', real(ncheck, jprb) * epsilon(1.0_jprb) + write(nout, '(a)') '*******************************' + error stop + endif + endif + endif +endif + +if (luse_mpi) then + call mpl_allreduce(ztloop, 'sum', ldreprod=.false.) + call mpl_allreduce(ztstep, 'sum', ldreprod=.false.) + call mpl_allreduce(ztstepavg, 'sum', ldreprod=.false.) + call mpl_allreduce(ztstepmax, 'max', ldreprod=.false.) + call mpl_allreduce(ztstepmin, 'min', ldreprod=.false.) + + call mpl_allreduce(ztstep1, 'sum', ldreprod=.false.) + call mpl_allreduce(ztstepavg1, 'sum', ldreprod=.false.) + call mpl_allreduce(ztstepmax1, 'max', ldreprod=.false.) + call mpl_allreduce(ztstepmin1, 'min', ldreprod=.false.) + + call mpl_allreduce(ztstep2, 'sum', ldreprod=.false.) + call mpl_allreduce(ztstepavg2, 'sum', ldreprod=.false.) + call mpl_allreduce(ztstepmax2, 'max', ldreprod=.false.) + call mpl_allreduce(ztstepmin2, 'min', ldreprod=.false.) +endif + +ztstepavg = (ztstepavg/real(nproc,jprb))/real(iters,jprd) +ztloop = ztloop/real(nproc,jprd) +ztstep(:) = ztstep(:)/real(nproc,jprd) + +call sort(ztstep,iters) +ztstepmed = ztstep(iters/2) + +ztstepavg1 = (ztstepavg1/real(nproc,jprb))/real(iters,jprd) +ztstep1(:) = ztstep1(:)/real(nproc,jprd) + +call sort(ztstep1, iters) +ztstepmed1 = ztstep1(iters/2) + +ztstepavg2 = (ztstepavg2/real(nproc,jprb))/real(iters,jprd) +ztstep2(:) = ztstep2(:)/real(nproc,jprd) + +call sort(ztstep2,iters) +ztstepmed2 = ztstep2(iters/2) + + +write(nout,'(a)') '======= Start of time step stats =======' +write(nout,'(" ")') +write(nout,'("Inverse transforms")') +write(nout,'("------------------")') +write(nout,'("avg (s): ",f8.4)') ztstepavg1 +write(nout,'("min (s): ",f8.4)') ztstepmin1 +write(nout,'("max (s): ",f8.4)') ztstepmax1 +write(nout,'("med (s): ",f8.4)') ztstepmed1 +write(nout,'(" ")') +write(nout,'("Direct transforms")') +write(nout,'("-----------------")') +write(nout,'("avg (s): ",f8.4)') ztstepavg2 +write(nout,'("min (s): ",f8.4)') ztstepmin2 +write(nout,'("max (s): ",f8.4)') ztstepmax2 +write(nout,'("med (s): ",f8.4)') ztstepmed2 +write(nout,'(" ")') +write(nout,'("Inverse-direct transforms")') +write(nout,'("-------------------------")') +write(nout,'("avg (s): ",f8.4)') ztstepavg +write(nout,'("min (s): ",f8.4)') ztstepmin +write(nout,'("max (s): ",f8.4)') ztstepmax +write(nout,'("med (s): ",f8.4)') ztstepmed +write(nout,'("loop (s): ",f8.4)') ztloop +write(nout,'(" ")') +write(nout,'(a)') '======= End of time step stats =======' +write(nout,'(" ")') + +if (lstack) then + ! Gather stack usage statistics + istack = getstackusage() + if (myproc == 1) then + print 9000, istack + 9000 format("Stack utilisation information",/,& + &"=============================",//,& + &"Task size(bytes)",/,& + &"==== ===========",//,& + &" 1",11x,i10) + + do i = 2, nproc + call mpl_recv(istack, ksource=nprcids(i), ktag=i, cdstring='transform_test:') + print '(i4,11x,i10)', i, istack + enddo + else + call mpl_send(istack, kdest=nprcids(1), ktag=myproc, cdstring='transform_test:') + endif +endif + +!=================================================================================================== +! Cleanup +!=================================================================================================== + +! TODO: many more arrays to deallocate + +!=================================================================================================== + +if (lstats) then + call gstats(0,1) + call gstats_print(nout, zaveave, jpmaxstat) +endif + +if (lmeminfo) then + write(nout,*) + call ec_meminfo(nout, "", mpl_comm, kbarr=1, kiotask=-1, & + & kcall=1) +endif + +!=================================================================================================== +! Finalize MPI +!=================================================================================================== + +if (luse_mpi) then + call mpl_end(ldmeminfo=.false.) +endif + +!=================================================================================================== +! Close file +!=================================================================================================== + +if (nproc > 1) then + if (myproc /= 1) then + close(unit=nout) + endif +endif + +!=================================================================================================== + +contains + +!=================================================================================================== + +function get_int_value(cname, iarg) result(value) + + integer :: value + character(len=*), intent(in) :: cname + integer, intent(inout) :: iarg + character(len=128) :: carg + integer :: stat + + carg = get_str_value(cname, iarg) + call str2int(carg, value, stat) + + if (stat /= 0) then + call parsing_failed("Invalid argument for " // trim(cname) // ": " // trim(carg)) + end if + +end function + +!=================================================================================================== + +function get_str_value(cname, iarg) result(value) + + character(len=128) :: value + character(len=*), intent(in) :: cname + integer, intent(inout) :: iarg + + iarg = iarg + 1 + call get_command_argument(iarg, value) + + if (value == "") then + call parsing_failed("Invalid argument for " // trim(cname) // ": no value provided") + end if + +end function + +!=================================================================================================== + +subroutine parsing_failed(message) + + character(len=*), intent(in) :: message + if (luse_mpi) call mpl_init(ldinfo=.false.) + if (ec_mpirank() == 0) then + write(nerr,"(a)") trim(message) + call print_help(unit=nerr) + endif + if (luse_mpi) call mpl_end(ldmeminfo=.false.) + stop + +end subroutine + +!=================================================================================================== + +subroutine get_command_line_arguments(nlon, nlat, nsmax, nmsmax, & + & iters, nfld, nlev, lvordiv, lscders, luvders, & + & nproma, verbosity, ldump_values, lprint_norms, & + & lmeminfo, nprgpns, nprgpew, nprtrv, nprtrw, ncheck) + + integer, intent(inout) :: nlon ! Zonal dimension + integer, intent(inout) :: nlat ! Meridional dimension + integer, intent(inout) :: nsmax ! Meridional truncation + integer, intent(inout) :: nmsmax ! Zonal trunciation + integer, intent(inout) :: iters ! Number of iterations for transform test + integer, intent(inout) :: nfld ! Number of scalar fields + integer, intent(inout) :: nlev ! Number of vertical levels + logical, intent(inout) :: lvordiv ! Also transform vorticity/divergence + logical, intent(inout) :: lscders ! Compute scalar derivatives + logical, intent(inout) :: luvders ! Compute uv East-West derivatives + integer, intent(inout) :: nproma ! NPROMA + integer, intent(inout) :: verbosity ! Level of verbosity + logical, intent(inout) :: ldump_values ! Dump values of grid point fields for debugging + logical, intent(inout) :: lprint_norms ! Calculate and print spectral norms of fields + logical, intent(inout) :: lmeminfo ! Show information from FIAT ec_meminfo routine at the + ! end + integer, intent(inout) :: nprgpns ! Size of NS set (gridpoint decomposition) + integer, intent(inout) :: nprgpew ! Size of EW set (gridpoint decomposition) + integer, intent(inout) :: nprtrv ! Size of V set (spectral decomposition) + integer, intent(inout) :: nprtrw ! Size of W set (spectral decomposition) + integer, intent(inout) :: ncheck ! The multiplier of the machine epsilon used as a + ! tolerance for correctness checking + + character(len=128) :: carg ! Storage variable for command line arguments + integer :: iarg = 1 ! Argument index + integer :: stat ! For storing success status of string->integer conversion + integer :: myproc + + do while (iarg <= command_argument_count()) + call get_command_argument(iarg, carg) + + select case(carg) + ! Parse help argument + case('-h', '--help') + if (luse_mpi) call mpl_init(ldinfo=.false.) + if (ec_mpirank()==0) call print_help() + if (luse_mpi) call mpl_end(ldmeminfo=.false.) + stop + ! Parse verbosity argument + case('-v') + verbosity = 1 + ! Parse number of iterations argument + case('-n', '--niter') + iters = get_int_value('-n', iarg) + if (iters < 1) then + call parsing_failed("Invalid argument for -n: must be > 0") + end if + ! Parse spectral truncation argument + case('--nlon'); nlon = get_int_value('--nlon', iarg) + case('--nlat'); nlat = get_int_value('--nlat', iarg) + case('--nsmax'); nsmax = get_int_value('--nsmax', iarg) + case('--nmsmax'); nmsmax = get_int_value('--nmsmax', iarg) + case('-f', '--nfld'); nfld = get_int_value('-f', iarg) + case('-l', '--nlev'); nlev = get_int_value('-l', iarg) + case('--vordiv'); lvordiv = .True. + case('--scders'); lscders = .True. + case('--uvders'); luvders = .True. + case('--nproma'); nproma = get_int_value('--nproma', iarg) + case('--dump-values'); ldump_values = .true. + case('--norms'); lprint_norms = .true. + case('--meminfo'); lmeminfo = .true. + case('--nprgpns'); nprgpns = get_int_value('--nprgpns', iarg) + case('--nprgpew'); nprgpew = get_int_value('--nprgpew', iarg) + case('--nprtrv'); nprtrv = get_int_value('--nprtrv', iarg) + case('--nprtrw'); nprtrw = get_int_value('--nprtrw', iarg) + case('-c', '--check'); ncheck = get_int_value('-c', iarg) + case default + call parsing_failed("Unrecognised argument: " // trim(carg)) + + end select + iarg = iarg + 1 + end do + + if (.not. lvordiv) then + luvders = .false. + endif + +end subroutine get_command_line_arguments + +!=================================================================================================== + +subroutine str2int(str, int, stat) + + character(len=*), intent(in) :: str + integer, intent(out) :: int + integer, intent(out) :: stat + read(str, *, iostat=stat) int + +end subroutine str2int + +!=================================================================================================== + +subroutine sort(a, n) + + real(kind=jprd), intent(inout) :: a(n) + integer(kind=jpim), intent(in) :: n + + real(kind=jprd) :: x + + integer :: i, j + + do i = 2, n + x = a(i) + j = i - 1 + do while (j >= 1) + if (a(j) <= x) exit + a(j + 1) = a(j) + j = j - 1 + end do + a(j + 1) = x + end do + +end subroutine sort + +!=================================================================================================== + +subroutine print_help(unit) + + integer, optional :: unit + integer :: nout = 6 + if (present(unit)) then + nout = unit + endif + + write(nout, "(a)") "" + + if (jprb == jprd) then + write(nout, "(a)") "NAME ectrans-lam-benchmark-dp" + else + write(nout, "(a)") "NAME ectrans-lam-benchmark-sp" + end if + write(nout, "(a)") "" + + write(nout, "(a)") "DESCRIPTION" + write(nout, "(a)") " This program tests ecTrans-lam by transforming fields back and forth& + & between spectral " + if (jprb == jprd) then + write(nout, "(a)") " space and grid-point space (double-precision version)" + else + write(nout, "(a)") " space and grid-point space (single-precision version)" + end if + write(nout, "(a)") "" + + write(nout, "(a)") "USAGE" + if (jprb == jprd) then + write(nout, "(a)") " ectrans-lam-benchmark-dp [options]" + else + write(nout, "(a)") " ectrans-lam-benchmark-sp [options]" + end if + write(nout, "(a)") "" + + write(nout, "(a)") "OPTIONS" + write(nout, "(a)") " -h, --help Print this message" + write(nout, "(a)") " -v Run with verbose output" + write(nout, "(a)") " --nlon NLON Number of gridpoints in zonal direction (default = 128)" + write(nout, "(a)") " --nlat NLAT Number of gridpoints in meridional direction (default = 128)" + write(nout, "(a)") " --nsmax NSMAX Spectral truncation in meridional direction (default = NLAT/2-1)" + write(nout, "(a)") " --nmsmax NMSMAX Spectral truncation in zonal direction (default = NLON/2-1)" + write(nout, "(a)") " -n, --niter NITER Run for this many inverse/direct transform& + & iterations (default = 10)" + write(nout, "(a)") " -f, --nfld NFLD Number of scalar fields (default = 1)" + write(nout, "(a)") " -l, --nlev NLEV Number of vertical levels (default = 1)" + write(nout, "(a)") " --vordiv Also transform vorticity-divergence to wind" + write(nout, "(a)") " --scders Compute scalar derivatives (default off)" + write(nout, "(a)") " --uvders Compute uv East-West derivatives (default off). Only& + & when also --vordiv is given" + write(nout, "(a)") " --nproma NPROMA Run with NPROMA (default no blocking: NPROMA=ngptot)" + write(nout, "(a)") " --norms Calculate and print spectral norms of transformed& + & fields" + write(nout, "(a)") " The computation of spectral norms will skew overall& + & timings" + write(nout, "(a)") " --meminfo Show diagnostic information from FIAT's ec_meminfo& + & subroutine on memory usage, thread-binding etc." + write(nout, "(a)") " --nprgpew Size of East-West set in gridpoint decomposition" + write(nout, "(a)") " --nprgpns Size of North-South set in gridpoint decomposition" + write(nout, "(a)") " --nprtrv Size of Vertical set in spectral decomposition" + write(nout, "(a)") " --nprtrw Size of Wave set in spectral decomposition" + write(nout, "(a)") " -c, --check VALUE The multiplier of the machine epsilon used as a& + & tolerance for correctness checking" + write(nout, "(a)") "" + write(nout, "(a)") "DEBUGGING" + write(nout, "(a)") " --dump-values Output gridpoint fields in unformatted binary file" + write(nout, "(a)") "" + +end subroutine print_help + +!=================================================================================================== + +subroutine initialize_spectral_arrays(nsmax, nmsmax, zsp, sp3d) + + integer, intent(in) :: nsmax ! Spectral truncation in meridional direction + integer, intent(in) :: nmsmax ! Spectral truncation in zonal direction + real(kind=jprb), intent(inout) :: zsp(:,:) ! Surface pressure + real(kind=jprb), intent(inout) :: sp3d(:,:,:) ! 3D fields + + integer(kind=jpim) :: nflevl + integer(kind=jpim) :: nfield + + integer :: i, j + + nflevl = size(sp3d, 1) + nfield = size(sp3d, 3) + + ! First initialize surface pressure + call initialize_2d_spectral_field(nsmax, nmsmax, zsp(1,:)) + + ! Then initialize all of the 3D fields + do i = 1, nflevl + do j = 1, nfield + call initialize_2d_spectral_field(nsmax, nmsmax, sp3d(i,:,j)) + end do + end do + +end subroutine initialize_spectral_arrays + +!=================================================================================================== + +subroutine initialize_2d_spectral_field(nsmax, nmsmax, field) + + integer, intent(in) :: nsmax ! Spectral truncation in meridional direction + integer, intent(in) :: nmsmax ! Spectral truncation in zonal direction + real(kind=jprb), intent(inout) :: field(:) ! Field to initialize + + integer :: ispec, kspec2 + integer, allocatable :: my_km(:), my_kn(:) + + ! Choose a harmonic to initialize arrays + integer :: m_num = 1 ! Zonal wavenumber + integer :: n_num = 0 ! Meridional wavenumber + + ! Type of initialization: (single) 'harmonic' or (random) 'spectrum' + character(len=32) :: init_type='harmonic' + + ! First initialise all spectral coefficients to zero + field(:) = 0.0 + + ! make sure wavenumbers are within truncation + if ( m_num>nmsmax .or. n_num > nsmax .or. & + & ( nsmax>0 .and. nmsmax>0 .and. ( (m_num/real(nmsmax))**2+(n_num/real(nsmax))**2 ) > 1.) ) then + write (nerr,*) + write (nerr,*) 'WARNING: INITIAL WAVENUMBERS OUTSIDE OF TRUNCATION! ' + write (nerr,*) ' m_num = ',m_num,'; nmsmax = ',nmsmax,'; n_num = ',n_num,'; nsmax = ',nsmax,& + & '; ellips check: ',(m_num/real(nmsmax))**2+(n_num/real(nsmax))**2 + write (nerr,*) ' using (kx=',NMSMAX/2,', ky=', NSMAX/2,') instead' + write (nerr,*) + m_num=nmsmax/2 + n_num=nsmax/2 + endif + + ! Get wavenumbers this rank is responsible for + call etrans_inq(kspec2=kspec2) + allocate(my_kn(kspec2),my_km(kspec2)) + call etrans_inq(knvalue=my_kn,kmvalue=my_km) + + ! If rank is responsible for the chosen zonal wavenumber... + if ( init_type == 'harmonic' ) then + do ispec=1,nspec2,4 + if ( my_kn(ispec)== n_num .and. my_km(ispec) == m_num ) then + field(ispec)=1.0 ! cos*cos + !field(ispec+1)=1.0 ! cos*sin + !field(ispec+2)=1.0 ! sin*cos + !field(ispec+3)=1.0 ! sin*sin + end if + enddo + endif + + ! random power spectrum + if ( init_type == 'spectrum' ) then + call random_number(field) + field=2*field-1. ! center around zero + ! set some components to zero because they are unphysical + do ispec=1,nspec2,4 + if ( my_kn(ispec)== 0 .and. my_km(ispec) == 0 ) field(ispec:ispec+3)=0. ! remove mean value for vorticity and divergence + if ( my_kn(ispec)== 0 ) field(ispec+1:ispec+3:2)=0. ! remove sine component on zero-wavenumber + if ( my_kn(ispec)== nmsmax ) field(ispec+1:ispec+3:2)=0. ! remove sine component on last-wavenumber + if ( my_km(ispec)== 0 ) field(ispec+2:ispec+3)=0. ! remove sine component on zero-wavenumber + if ( my_km(ispec)== nsmax ) field(ispec+2:ispec+3)=0. ! remove sine component on last-wavenumber + enddo + + ! scale according to wavenumber**2 + do ispec=1,nspec2 + field(ispec)=field(ispec)/(0.01+(my_kn(ispec)/real(nsmax))**2+(my_km(ispec)/real(nmsmax))**2) + enddo + endif + +end subroutine initialize_2d_spectral_field + +!=================================================================================================== + +subroutine dump_gridpoint_field(jstep, myproc, nlat, nproma, ngpblks, fld, fldchar, noutdump) + + ! Dump a 2d gridpoint field to screen or a binary file. + + integer(kind=jpim), intent(in) :: jstep ! Time step, used for naming file + integer(kind=jpim), intent(in) :: myproc ! MPI rank, used for naming file + integer(kind=jpim), intent(in) :: nlat ! Number of latitudes + integer(kind=jpim), intent(in) :: nproma ! Size of nproma + integer(kind=jpim), intent(in) :: ngpblks ! Number of nproma blocks + real(kind=jprb) , intent(in) :: fld(nproma,1,ngpblks) ! 2D field + character , intent(in) :: fldchar ! Single character field identifier + integer(kind=jpim), intent(in) :: noutdump ! Unit number for output file + + integer(kind=jpim) :: kgptotg ! global number of gridpoints + real(kind=jprb), allocatable :: fldg(:,:) ! global field + integer(kind=jpim) :: kfgathg=1 ! number of fields to gather + integer(kind=jpim) :: kto(1)=(/1/) ! processor where to gather + character(len=14) :: filename = "x.xxx.xxx.grid" + character(len=13) :: frmt='(4X,xxxxF8.2)' + +#include "etrans_inq.h" +#include "egath_grid.h" + + call etrans_inq(kgptotg=kgptotg) + + if ( myproc == 1 ) allocate(fldg(kgptotg,1)) + + call egath_grid(pgpg=fldg,kproma=nproma,kfgathg=kfgathg,kto=kto,pgp=fld) + + if ( myproc == 1 ) then + + ! write to file + write(filename(1:1),'(a1)') fldchar + write(filename(3:5),'(i3.3)') jstep +#ifdef ACCGPU + write(filename(7:9),'(a3)') 'gpu' +#else + write(filename(7:9),'(a3)') 'cpu' +#endif + open(noutdump, file=filename, form="unformatted", access="stream") + write(noutdump) kgptotg/nlat,nlat ! dimensions + write(noutdump) fldg ! data + close(noutdump) + + ! write to screen + write(frmt(5:8),'(i4.4)') kgptotg/nlat + write (*,*) fldchar,' at iteration ',jstep,':' + write (*,frmt) fldg + call flush(6) + + deallocate(fldg) + + endif + + +end subroutine dump_gridpoint_field + +!=================================================================================================== + +subroutine dump_spectral_field(jstep, myproc, nspec2, nsmax, nmsmax, fld, kvset, fldchar, noutdump) + + ! Dump a 2d spectral field to screen or a binary file. + + integer(kind=jpim), intent(in) :: jstep ! Time step, used for naming file + integer(kind=jpim), intent(in) :: myproc ! MPI rank, used for naming file + integer(kind=jpim), intent(in) :: nspec2 ! Size of nspec2 (number of waves on this proc in M-space) + integer(kind=jpim), intent(in) :: nsmax + integer(kind=jpim), intent(in) :: nmsmax + real(kind=jprb) , intent(in) :: fld(1,nspec2) ! 2D field + integer(kind=jpim), intent(in) :: kvset(1) ! B-set on which the field resides + character , intent(in) :: fldchar ! Single character field identifier + integer(kind=jpim), intent(in) :: noutdump ! Unit number for output file + + integer(kind=jpim) :: nspec2g ! global number of gridpoints + real(kind=jprb), allocatable :: fldg(:,:) ! global field (nspec2g) + integer(kind=jpim) :: kfgathg=1 ! number of fields to gather + integer(kind=jpim) :: kto(1)=(/1/) ! processor where to gather + character(len=14) :: filename = "x.xxx.xxx.spec" + character(len=13) :: frmt='(4X,xxxxF8.2)' ! for printing to screen + integer(kind=jpim) :: knse(0:nmsmax),kmse(0:nsmax) ! elliptic truncation + real(kind=jprb) :: fld2g(0:2*nmsmax+1,0:2*nsmax+1) ! 2D representation of spectral field + integer(kind=jpim) :: jj, jms, jns + +#include "etrans_inq.h" +#include "egath_spec.h" + + if ( myproc == 1 ) then + call etrans_inq(kspec2g=nspec2g) + allocate(fldg(1,nspec2g)) + call ellips(nsmax,nmsmax,knse,kmse) + endif + + call egath_spec(PSPECG=fldg,kfgathg=kfgathg,kto=kto,kvset=kvset,PSPEC=fld) + + if ( myproc == 1 ) then + + fld2g=0. + jj=1 + do jms=0,nmsmax + do jns=0,knse(jms) + fld2g(2*jms+0,2*jns+0)=fldg(1,jj) + fld2g(2*jms+0,2*jns+1)=fldg(1,jj+1) + fld2g(2*jms+1,2*jns+0)=fldg(1,jj+2) + fld2g(2*jms+1,2*jns+1)=fldg(1,jj+3) + jj=jj+4 + enddo + enddo + + ! write to binary file + write(filename(1:1),'(a1)') fldchar + write(filename(3:5),'(i3.3)') jstep +#ifdef ACCGPU + write(filename(7:9),'(a3)') 'gpu' +#else + write(filename(7:9),'(a3)') 'cpu' +#endif + open(noutdump, file=filename, form="unformatted", access="stream") + write(noutdump) 2*nmsmax+2,2*nsmax+2 ! dimensions + write(noutdump) fld2g ! data + close(noutdump) + + ! write to screen + write(frmt(5:8),'(i4.4)') 2*(nmsmax+1) + write (*,*) fldchar,' at iteration ',jstep,':' + write (*,frmt) fld2g + call flush(6) + + deallocate(fldg) + + endif + + +end subroutine dump_spectral_field + +!=================================================================================================== + +function detect_mpirun() result(lmpi_required) + logical :: lmpi_required + integer :: ilen + integer, parameter :: nvars = 5 + character(len=32), dimension(nvars) :: cmpirun_detect + character(len=4) :: clenv_dr_hook_assert_mpi_initialized + integer :: ivar + + ! Environment variables that are set when mpirun, srun, aprun, ... are used + cmpirun_detect(1) = 'OMPI_COMM_WORLD_SIZE' ! openmpi + cmpirun_detect(2) = 'ALPS_APP_PE' ! cray pe + cmpirun_detect(3) = 'PMI_SIZE' ! intel + cmpirun_detect(4) = 'SLURM_NTASKS' ! slurm + cmpirun_detect(5) = 'ECTRANS_USE_MPI' ! forced + + lmpi_required = .false. + do ivar = 1, nvars + call get_environment_variable(name=trim(cmpirun_detect(ivar)), length=ilen) + if (ilen > 0) then + lmpi_required = .true. + exit ! break + endif + enddo +end function + +!=================================================================================================== + +! Assign GSTATS labels to the main regions of ecTrans +subroutine gstats_labels + + call gstats_label(0, ' ', 'PROGRAM - Total') + call gstats_label(1, ' ', 'SETUP_TRANS0 - Setup ecTrans') + call gstats_label(2, ' ', 'SETUP_TRANS - Setup ecTrans handle') + call gstats_label(3, ' ', 'TIME STEP - Time step') + call gstats_label(4, ' ', 'INV_TRANS - Inverse transform') + call gstats_label(5, ' ', 'DIR_TRANS - Direct transform') + call gstats_label(6, ' ', 'NORMS - Norm comp. (optional)') + call gstats_label(102, ' ', 'LTINV_CTL - Inv. Legendre transform') + call gstats_label(103, ' ', 'LTDIR_CTL - Dir. Legendre transform') + call gstats_label(106, ' ', 'FTDIR_CTL - Dir. Fourier transform') + call gstats_label(107, ' ', 'FTINV_CTL - Inv. Fourier transform') + call gstats_label(140, ' ', 'SULEG - Comp. of Leg. poly.') + call gstats_label(152, ' ', 'LTINV_CTL - M to L transposition') + call gstats_label(153, ' ', 'LTDIR_CTL - L to M transposition') + call gstats_label(157, ' ', 'FTINV_CTL - L to G transposition') + call gstats_label(158, ' ', 'FTDIR_CTL - G to L transposition') + call gstats_label(400, ' ', 'GSTATS - GSTATS itself') + +end subroutine gstats_labels + +end program ectrans_lam_benchmark + +!=================================================================================================== \ No newline at end of file diff --git a/src/trans/CMakeLists.txt b/src/trans/CMakeLists.txt index 256ad4170..f4670febf 100644 --- a/src/trans/CMakeLists.txt +++ b/src/trans/CMakeLists.txt @@ -40,6 +40,20 @@ ecbuild_list_add_pattern( LIST trans_src QUIET ) +if ( HAVE_ETRANS ) + # add LAM sources + ecbuild_list_add_pattern( LIST trans_src + GLOB + ../etrans/biper/internal/* + ../etrans/biper/external/* + ../etrans/etrans/aux/* + ../etrans/etrans/internal/* + ../etrans/etrans/external/* + QUIET + ) +endif() + + if( NOT HAVE_FFTW ) ecbuild_list_exclude_pattern( LIST trans_src REGEX tpm_fftw.F90 ) endif() @@ -56,6 +70,8 @@ foreach( prec sp dp ) SOURCES ${trans_src} PUBLIC_INCLUDES $ $ + $ + $ $ $ PUBLIC_LIBS fiat parkind_${prec} @@ -86,8 +102,22 @@ foreach( prec sp dp ) endforeach() ## Install trans interface +ecbuild_list_add_pattern( LIST trans_interface + GLOB + include/ectrans/* + QUIET + ) + +if ( HAVE_ETRANS ) + # add LAM interfaces + ecbuild_list_add_pattern( LIST trans_interface + GLOB + ../etrans/biper/include/* + ../etrans/etrans/include/* + QUIET + ) +endif() -file( GLOB trans_interface include/ectrans/* ) install( FILES ${trans_interface} DESTINATION include/ectrans From cae92ee0d78661ac0f5aea4a8643d02b62c806a4 Mon Sep 17 00:00:00 2001 From: Daan Degrauwe Date: Thu, 30 May 2024 15:55:24 +0200 Subject: [PATCH 05/25] cleaned installation a bit: only one library (trans) instead of separate (trans, etrans, biper); only single include directory --- src/CMakeLists.txt | 6 ++-- src/etrans/CMakeLists.txt | 38 ++++++++++++++++++++-- src/etrans/biper/CMakeLists.txt | 44 -------------------------- src/etrans/etrans/CMakeLists.txt | 54 -------------------------------- src/trans/CMakeLists.txt | 30 +----------------- 5 files changed, 40 insertions(+), 132 deletions(-) delete mode 100644 src/etrans/biper/CMakeLists.txt delete mode 100644 src/etrans/etrans/CMakeLists.txt diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index e6410ad64..81883e1d2 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -11,6 +11,6 @@ add_subdirectory( programs ) if( HAVE_TRANSI ) add_subdirectory(transi) endif() -#if( HAVE_ETRANS ) -# add_subdirectory(etrans) -#endif() \ No newline at end of file +if( HAVE_ETRANS ) + add_subdirectory(etrans) +endif() \ No newline at end of file diff --git a/src/etrans/CMakeLists.txt b/src/etrans/CMakeLists.txt index 7d8c39f0a..31cf11d7b 100644 --- a/src/etrans/CMakeLists.txt +++ b/src/etrans/CMakeLists.txt @@ -1,2 +1,36 @@ -add_subdirectory(biper) -add_subdirectory(etrans) \ No newline at end of file +# build list of sources to add to trans library +# (using CMAKE_CURRENT_SOURCE_DIR is necessary because sources are in a different directory than the target library (trans_${prec}) +ecbuild_list_add_pattern( LIST etrans_src + GLOB + ${CMAKE_CURRENT_SOURCE_DIR}/biper/internal/* + ${CMAKE_CURRENT_SOURCE_DIR}/biper/external/* + ${CMAKE_CURRENT_SOURCE_DIR}/etrans/aux/* + ${CMAKE_CURRENT_SOURCE_DIR}/etrans/internal/* + ${CMAKE_CURRENT_SOURCE_DIR}/etrans/external/* + QUIET + ) + +# dummies to be able to loop over precisions +set( HAVE_dp ${HAVE_DOUBLE_PRECISION} ) +set( HAVE_sp ${HAVE_SINGLE_PRECISION} ) + +# loop over precisions +foreach( prec sp dp ) + if( HAVE_${prec} ) + # add sources + target_sources(trans_${prec} PRIVATE ${etrans_src}) + # add include directories + target_include_directories(trans_${prec} + PRIVATE + $ + $ + ) + endif() +endforeach() + +# install headers +file( GLOB etrans_interface biper/include/* etrans/include/*) +install( + FILES ${etrans_interface} + DESTINATION include/ectrans +) diff --git a/src/etrans/biper/CMakeLists.txt b/src/etrans/biper/CMakeLists.txt deleted file mode 100644 index 2159dc72e..000000000 --- a/src/etrans/biper/CMakeLists.txt +++ /dev/null @@ -1,44 +0,0 @@ -## Assemble sources -ecbuild_list_add_pattern( LIST biper_src - GLOB - internal/* - external/* - QUIET - ) - -set( HAVE_dp ${HAVE_DOUBLE_PRECISION} ) -set( HAVE_sp ${HAVE_SINGLE_PRECISION} ) - -foreach( prec sp dp ) - if( HAVE_${prec} ) - - ecbuild_add_library( - TARGET biper_${prec} - LINKER_LANGUAGE Fortran - SOURCES ${biper_src} - #PUBLIC_INCLUDES #$ - #$ - #$ - #$ - PUBLIC_LIBS fiat parkind_${prec} - PRIVATE_LIBS trans_${prec} - ) - - #target_link_libraries( biper_${prec} PUBLIC fiat parkind_${prec} trans_${prec}) - - # not sure if modules should be installed: shouldn't biper be accessed through interface routines? - ectrans_target_fortran_module_directory( - TARGET biper_${prec} - MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/module/biper_${prec} - INSTALL_DIRECTORY module/biper_${prec} - ) - - endif() -endforeach() - -## Install biper interface -file( GLOB biper_interface include/biper/* ) -install( - FILES ${biper_interface} - DESTINATION include/ectrans -) diff --git a/src/etrans/etrans/CMakeLists.txt b/src/etrans/etrans/CMakeLists.txt deleted file mode 100644 index a29547d27..000000000 --- a/src/etrans/etrans/CMakeLists.txt +++ /dev/null @@ -1,54 +0,0 @@ - -## Assemble sources - -ecbuild_list_add_pattern( LIST etrans_src - GLOB - internal/* - external/* - aux/*.F90 - QUIET - ) - -set( HAVE_dp ${HAVE_DOUBLE_PRECISION} ) -set( HAVE_sp ${HAVE_SINGLE_PRECISION} ) - -foreach( prec sp dp ) - if( HAVE_${prec} ) - - ecbuild_add_library( - TARGET etrans_${prec} - LINKER_LANGUAGE Fortran - SOURCES ${etrans_src} - PUBLIC_INCLUDES #$ - $ - $ - #$ - PUBLIC_LIBS fiat parkind_${prec} - PRIVATE_LIBS trans_${prec} biper_${prec} - ) - ectrans_target_fortran_module_directory( - TARGET etrans_${prec} - MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/module/etrans_${prec} - INSTALL_DIRECTORY module/etrans_${prec} - ) - #target_link_libraries( biper_${prec} PUBLIC fiat parkind_${prec} trans_${prec} biper_${prec}) - #if( HAVE_FFTW ) # already resolved from trans, I presume - # target_link_libraries( etrans_${prec} ${FFTW_LINK} ${FFTW_LIBRARIES} ) - # target_include_directories( etrans_${prec} PRIVATE ${FFTW_INCLUDE_DIRS} ) - # target_compile_definitions( etrans_${prec} PRIVATE WITH_FFTW ) - #endif() - #target_link_libraries( etrans_${prec} ${LAPACK_LINK} ${LAPACK_${prec}} ) # lapack isn't used by etrans - #if( HAVE_OMP ) # already resolved from trans, I presume - # target_link_libraries( etrans_${prec} PRIVATE OpenMP::OpenMP_Fortran ) - #endif() - - endif() -endforeach() - -## Install trans interface - -file( GLOB etrans_interface include/etrans/* ) -install( - FILES ${etrans_interface} - DESTINATION include/ectrans -) diff --git a/src/trans/CMakeLists.txt b/src/trans/CMakeLists.txt index f4670febf..a19490eae 100644 --- a/src/trans/CMakeLists.txt +++ b/src/trans/CMakeLists.txt @@ -40,19 +40,6 @@ ecbuild_list_add_pattern( LIST trans_src QUIET ) -if ( HAVE_ETRANS ) - # add LAM sources - ecbuild_list_add_pattern( LIST trans_src - GLOB - ../etrans/biper/internal/* - ../etrans/biper/external/* - ../etrans/etrans/aux/* - ../etrans/etrans/internal/* - ../etrans/etrans/external/* - QUIET - ) -endif() - if( NOT HAVE_FFTW ) ecbuild_list_exclude_pattern( LIST trans_src REGEX tpm_fftw.F90 ) @@ -102,22 +89,7 @@ foreach( prec sp dp ) endforeach() ## Install trans interface -ecbuild_list_add_pattern( LIST trans_interface - GLOB - include/ectrans/* - QUIET - ) - -if ( HAVE_ETRANS ) - # add LAM interfaces - ecbuild_list_add_pattern( LIST trans_interface - GLOB - ../etrans/biper/include/* - ../etrans/etrans/include/* - QUIET - ) -endif() - +file( GLOB trans_interface include/ectrans/* ) install( FILES ${trans_interface} DESTINATION include/ectrans From 98d0037a291cae12a802b27f87b98306af8fbbae Mon Sep 17 00:00:00 2001 From: Daan Degrauwe Date: Mon, 10 Jun 2024 09:50:06 +0200 Subject: [PATCH 06/25] removed reference to etrans from trans/CMakeLists.txt --- src/etrans/CMakeLists.txt | 2 +- src/trans/CMakeLists.txt | 2 -- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/src/etrans/CMakeLists.txt b/src/etrans/CMakeLists.txt index 31cf11d7b..bd88b450e 100644 --- a/src/etrans/CMakeLists.txt +++ b/src/etrans/CMakeLists.txt @@ -21,7 +21,7 @@ foreach( prec sp dp ) target_sources(trans_${prec} PRIVATE ${etrans_src}) # add include directories target_include_directories(trans_${prec} - PRIVATE + PUBLIC $ $ ) diff --git a/src/trans/CMakeLists.txt b/src/trans/CMakeLists.txt index a19490eae..0464597a5 100644 --- a/src/trans/CMakeLists.txt +++ b/src/trans/CMakeLists.txt @@ -57,8 +57,6 @@ foreach( prec sp dp ) SOURCES ${trans_src} PUBLIC_INCLUDES $ $ - $ - $ $ $ PUBLIC_LIBS fiat parkind_${prec} From 0ed874b739f5b4a6c503ea37b77e9f442111115e Mon Sep 17 00:00:00 2001 From: Daan Degrauwe Date: Tue, 3 Sep 2024 14:27:00 +0200 Subject: [PATCH 07/25] moved ellips to fiat --- src/etrans/CMakeLists.txt | 1 - src/etrans/etrans/aux/ellips.F90 | 8 --- src/etrans/etrans/aux/ellips.h | 91 ------------------------------ src/etrans/etrans/aux/ellips64.F90 | 8 --- 4 files changed, 108 deletions(-) delete mode 100644 src/etrans/etrans/aux/ellips.F90 delete mode 100644 src/etrans/etrans/aux/ellips.h delete mode 100644 src/etrans/etrans/aux/ellips64.F90 diff --git a/src/etrans/CMakeLists.txt b/src/etrans/CMakeLists.txt index bd88b450e..bb6d3c2c5 100644 --- a/src/etrans/CMakeLists.txt +++ b/src/etrans/CMakeLists.txt @@ -4,7 +4,6 @@ ecbuild_list_add_pattern( LIST etrans_src GLOB ${CMAKE_CURRENT_SOURCE_DIR}/biper/internal/* ${CMAKE_CURRENT_SOURCE_DIR}/biper/external/* - ${CMAKE_CURRENT_SOURCE_DIR}/etrans/aux/* ${CMAKE_CURRENT_SOURCE_DIR}/etrans/internal/* ${CMAKE_CURRENT_SOURCE_DIR}/etrans/external/* QUIET diff --git a/src/etrans/etrans/aux/ellips.F90 b/src/etrans/etrans/aux/ellips.F90 deleted file mode 100644 index e3af47323..000000000 --- a/src/etrans/etrans/aux/ellips.F90 +++ /dev/null @@ -1,8 +0,0 @@ -! Oct-2012 P. Marguinaud 64b LFI - -#undef JLIK -#undef _ELLIPS_ -#define JLIK JPIM -#define _ELLIPS_ ELLIPS -#include "ellips.h" - diff --git a/src/etrans/etrans/aux/ellips.h b/src/etrans/etrans/aux/ellips.h deleted file mode 100644 index 1e82d565e..000000000 --- a/src/etrans/etrans/aux/ellips.h +++ /dev/null @@ -1,91 +0,0 @@ -! Jan-2011 P. Marguinaud Interface to thread-safe FA -SUBROUTINE _ELLIPS_ (KSMAX,KMSMAX,KNTMP,KMTMP) -USE PARKIND1, ONLY : JPRB, JPRD, JPIM, JPIB -USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK -IMPLICIT NONE -! -! ***ELLIPS*** - General routine for computing elliptic truncation -! -! Purpose. -! -------- -! Computation of zonal and meridional limit wavenumbers within the ellipse -! Interface: -! ---------- -! *CALL* *ELLIPS * -! -! Explicit arguments : -! -------------------- -! -! Implicit arguments : -! -------------------- -! -! -! Method. -! ------- -! See documentation -! -! Externals. NONE. -! ---------- -! -! Reference. -! ---------- -! ARPEGE/ALADIN documentation -! -! Author. -! ------- -! G. Radnoti LACE 97/04/04 -! -! Modifications. -! -!------------------------------------------------------------- -! J.Vivoda, 99/05/19 treating NSMAX=0 and NMSMAX=0 -! O.Nuissier, 23/09/01 Change type of real (simple --> -! double precision) -! -! -INTEGER (KIND=JLIK) KSMAX, KMSMAX -INTEGER (KIND=JLIK) KNTMP(0:KMSMAX),KMTMP(0:KSMAX) -! -INTEGER (KIND=JLIK) JM, JN -! -REAL (KIND=JPRD) ZEPS, ZKN, ZKM, ZAUXIL -! -REAL(KIND=JPHOOK) :: ZHOOK_HANDLE -IF (LHOOK) CALL DR_HOOK('ELLIPS',0,ZHOOK_HANDLE) -ZEPS=1.E-10 -ZAUXIL=0. -! -! 1. Computing meridional limit wavenumbers along zonal wavenumbers -! -DO JM=1,KMSMAX-1 -ZKN = REAL(KSMAX,JPRD)/REAL(KMSMAX,JPRD)* & -& SQRT(MAX(ZAUXIL,REAL(KMSMAX**2-JM**2,JPRD))) - KNTMP(JM)=INT(ZKN+ZEPS, JLIK) -ENDDO - -IF( KMSMAX.EQ.0 )THEN - KNTMP(0)=KSMAX -ELSE - KNTMP(0)=KSMAX - KNTMP(KMSMAX)=0 -ENDIF -! -! 2. Computing zonal limit wavenumbers along meridional wavenumbers -! -DO JN=1,KSMAX-1 -ZKM = REAL(KMSMAX,JPRD)/REAL(KSMAX,JPRD)* & - & SQRT(MAX(ZAUXIL,REAL(KSMAX**2-JN**2,JPRD))) - KMTMP(JN)=INT(ZKM+ZEPS, JLIK) -ENDDO - -IF( KSMAX.EQ.0 )THEN - KMTMP(0)=KMSMAX -ELSE - KMTMP(0)=KMSMAX - KMTMP(KSMAX)=0 -ENDIF -! -IF (LHOOK) CALL DR_HOOK('ELLIPS',1,ZHOOK_HANDLE) -END - - diff --git a/src/etrans/etrans/aux/ellips64.F90 b/src/etrans/etrans/aux/ellips64.F90 deleted file mode 100644 index 083938214..000000000 --- a/src/etrans/etrans/aux/ellips64.F90 +++ /dev/null @@ -1,8 +0,0 @@ -! Oct-2012 P. Marguinaud 64b LFI - -#undef JLIK -#undef _ELLIPS_ -#define JLIK JPIB -#define _ELLIPS_ ELLIPS64 -#include "ellips.h" - From ba837f4a1bb4a2dcc0a6742015d423ff665dee7c Mon Sep 17 00:00:00 2001 From: Walid CHIKHI Date: Sat, 19 Oct 2024 11:09:01 +0100 Subject: [PATCH 08/25] add ectrans python interface ectrans4py (cherry picked from commit 8d9307fa4313e21b2ef9a7e12fa6baae0e701aea) --- CMakeLists.txt | 8 + MANIFEST.in | 8 + pyproject.toml | 4 + setup.py | 32 +++ src/CMakeLists.txt | 5 +- src/ectrans4py/CMakeLists.txt | 20 ++ src/ectrans4py/__init__.py | 389 ++++++++++++++++++++++++++++++ src/ectrans4py/etrans_inq4py.F90 | 66 +++++ src/ectrans4py/gp2sp_gauss4py.F90 | 113 +++++++++ src/ectrans4py/gp2sp_lam4py.f90 | 121 ++++++++++ src/ectrans4py/sp2gp_fft1d4py.F90 | 114 +++++++++ src/ectrans4py/sp2gp_gauss4py.F90 | 123 ++++++++++ src/ectrans4py/sp2gp_lam4py.F90 | 140 +++++++++++ src/ectrans4py/spec_setup4py.F90 | 160 ++++++++++++ src/ectrans4py/trans_inq4py.F90 | 70 ++++++ 15 files changed, 1372 insertions(+), 1 deletion(-) create mode 100644 MANIFEST.in create mode 100644 pyproject.toml create mode 100644 setup.py create mode 100644 src/ectrans4py/CMakeLists.txt create mode 100644 src/ectrans4py/__init__.py create mode 100644 src/ectrans4py/etrans_inq4py.F90 create mode 100644 src/ectrans4py/gp2sp_gauss4py.F90 create mode 100644 src/ectrans4py/gp2sp_lam4py.f90 create mode 100644 src/ectrans4py/sp2gp_fft1d4py.F90 create mode 100644 src/ectrans4py/sp2gp_gauss4py.F90 create mode 100644 src/ectrans4py/sp2gp_lam4py.F90 create mode 100644 src/ectrans4py/spec_setup4py.F90 create mode 100644 src/ectrans4py/trans_inq4py.F90 diff --git a/CMakeLists.txt b/CMakeLists.txt index aec33e15b..995cd9e95 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -35,6 +35,7 @@ ecbuild_add_option( FEATURE SINGLE_PRECISION DEFAULT ON DESCRIPTION "Support for Single Precision" ) + if( HAVE_SINGLE_PRECISION ) set( single "single" ) endif() @@ -64,6 +65,13 @@ ecbuild_add_option( FEATURE ETRANS DEFAULT OFF DESCRIPTION "Include Limited-Area-Model Transforms" ) + +ecbuild_add_option( FEATURE ECTRANS4PY + DEFAULT OFF + CONDITION HAVE_ETRANS + DESCRIPTION "Compile ectrans4py interface routines for python binding w/ ctypesForFortran" ) + + ectrans_find_lapack() ### Add sources and tests diff --git a/MANIFEST.in b/MANIFEST.in new file mode 100644 index 000000000..1e1af65a5 --- /dev/null +++ b/MANIFEST.in @@ -0,0 +1,8 @@ +include AUTHORS +include CMakeLists.txt +include LICENSE +include README.md +include VERSION +recursive-include src * +recursive-include cmake * +recursive-include tests * diff --git a/pyproject.toml b/pyproject.toml new file mode 100644 index 000000000..a003b0c80 --- /dev/null +++ b/pyproject.toml @@ -0,0 +1,4 @@ +[build-system] +requires = ["setuptools", "wheel", "scikit-build"] +build-backend = "setuptools.build_meta" + diff --git a/setup.py b/setup.py new file mode 100644 index 000000000..80a8788eb --- /dev/null +++ b/setup.py @@ -0,0 +1,32 @@ +import os +import re +import ast +from skbuild import setup + +def get_version(): # remove this part + version_file = os.path.join("src", "ectrans4py", "__init__.py") + with open(version_file, "r", encoding="utf-8") as f: + content = f.read() + version_match = re.search(r"^__version__\s*=\s*['\"]([^'\"]*)['\"]", content, re.M) + if version_match: + return version_match.group(1) + raise RuntimeError("Unable to find version string.") + +version=get_version() +# ectrans4py package : +setup( + name="ectrans4py", + version=version, + packages=['ectrans4py'], + cmake_minimum_required_version="3.13", + cmake_args=[ + '-DENABLE_ETRANS=ON', + '-DENABLE_ECTRANS4PY=ON', + '-DENABLE_SINGLE_PRECISION=OFF', + '-DENABLE_OMP=OFF', + ], + package_dir={"": "src"}, + cmake_install_dir="src/ectrans4py", + setup_requires=["scikit-build", "setuptools"], + install_requires=["numpy", "ctypesforfortran==1.1.3"], +) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 81883e1d2..706806cd8 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -13,4 +13,7 @@ if( HAVE_TRANSI ) endif() if( HAVE_ETRANS ) add_subdirectory(etrans) -endif() \ No newline at end of file +endif() +if(HAVE_ECTRANS4PY) + add_subdirectory(ectrans4py) +endif() diff --git a/src/ectrans4py/CMakeLists.txt b/src/ectrans4py/CMakeLists.txt new file mode 100644 index 000000000..857d7d609 --- /dev/null +++ b/src/ectrans4py/CMakeLists.txt @@ -0,0 +1,20 @@ +if(HAVE_ETRANS) + # (using CMAKE_CURRENT_SOURCE_DIR is necessary because sources are in a different directory than the target library (trans_${prec})) + ecbuild_list_add_pattern( + LIST ectrans4py_src + GLOB ${CMAKE_CURRENT_SOURCE_DIR}/*.F90 + QUIET + ) + + set(HAVE_dp ${HAVE_DOUBLE_PRECISION}) + set(prec dp) + + if(HAVE_${prec}) + # Add sources + target_sources(trans_${prec} PRIVATE ${ectrans4py_src}) + endif() + +else() + ecbuild_critical("To activate the ectrans Python interface, you must enable the ETRANS option.") +endif() + diff --git a/src/ectrans4py/__init__.py b/src/ectrans4py/__init__.py new file mode 100644 index 000000000..5591f3465 --- /dev/null +++ b/src/ectrans4py/__init__.py @@ -0,0 +1,389 @@ +#!/usr/bin/env python3 +# -*- coding: utf-8 -*- +# Copyright (c) Météo France (2014-) +# This software is governed by the CeCILL-C license under French law. +# http://www.cecill.info +""" +ialsptrans4py: + +Contains the interface to spectral transforms from the IAL/ecTrans. +Note that this is temporary between the former package arpifs4py and a direct python interface to ecTrans. + +Actual .so library should be in one of the preinstalled paths or in a directory specified via LD_LIBRARY_PATH +""" + +from __future__ import print_function, absolute_import, unicode_literals, division + +import os +import numpy as np +import ctypesForFortran +from ctypesForFortran import addReturnCode, treatReturnCode, IN, OUT + + + +__version__ = "2.0.1" + +# Shared objects library +######################## +shared_objects_library = os.environ.get('IALSPTRANS4PY_SO', None) +if shared_objects_library is None or not os.path.exists(shared_objects_library): + # not specified or path does not exist : find in known locations + so_basename = "libtrans_dp.so" # local name in the directory + LD_LIBRARY_PATH = [p for p in os.environ.get('LD_LIBRARY_PATH', '').split(':') if p != ''] + potential_locations = LD_LIBRARY_PATH + [ + os.path.join(os.path.dirname(os.path.realpath(__file__)), 'lib'), # FIXEME : but requiere changes in CMakeLists.txt + os.path.join(os.path.dirname(os.path.realpath(__file__)), 'lib64'), # force one libdir directory name ! +# "/home/common/epygram/public/EPyGrAM/libs4py", # CNRM +# "/home/gmap/mrpe/mary/public/EPyGrAM/libs4py", # belenos/taranis +# "/home/acrd/public/EPyGrAM/libs4py", # ECMWF's Atos aa-ad + ] + for _libs4py_dir in potential_locations: + shared_objects_library = os.path.join(_libs4py_dir, so_basename) + if os.path.exists(shared_objects_library): + break + else: + shared_objects_library = None + if shared_objects_library is None: + msg = ' '.join(["'{}' was not found in any of potential locations: {}.", + "You can specify a different location using env var LD_LIBRARY_PATH", + "or specify a precise full path using env var IALSPTRANS4PY_SO."]).format( + so_filename, str(potential_locations)) + raise FileNotFoundError(msg) +else: + so_basename = os.path.basename(shared_objects_library) +ctypesFF, handle = ctypesForFortran.ctypesForFortranFactory(shared_objects_library) + +# Initialization +################ + +def init_env(omp_num_threads=None, + no_mpi=False): + """ + Set adequate environment for the inner libraries. + + :param int omp_num_threads: sets OMP_NUM_THREADS + :param bool no_mpi: environment variable DR_HOOK_NOT_MPI set to 1 + """ + # because arpifs library is compiled with MPI & openMP + if omp_num_threads is not None: + os.environ['OMP_NUM_THREADS'] = str(omp_num_threads) + if no_mpi: + os.environ['DR_HOOK_NOT_MPI'] = '1' + +# Transforms interfaces +####################### + +@treatReturnCode +@ctypesFF() +@addReturnCode +def etrans_inq4py(KSIZEI, KSIZEJ, + KPHYSICALSIZEI, KPHYSICALSIZEJ, + KTRUNCX, KTRUNCY, + KNUMMAXRESOL, + PDELATX, PDELATY): + """ + Simplified wrapper to ETRANS_INQ. + + Args:\n + 1,2) KSIZEI, KSIZEJ: size of grid-point field (with extension zone) + 3,4) KPHYSICALSIZEI, KPHYSICALSIZEJ: size of physical part of grid-point field + 5,6) KTRUNCX, KTRUNCY: troncatures + 7) KNUMMAXRESOL: maximum number of troncatures handled + 8,9) PDELTAX, PDELTAY: resolution along x,y axis + + Returns:\n + 1) KGPTOT: number of gridpoints + 2) KSPEC: number of spectral coefficients + """ + return ([KSIZEI, KSIZEJ, + KPHYSICALSIZEI, KPHYSICALSIZEJ, + KTRUNCX, KTRUNCY, + KNUMMAXRESOL, + PDELATX, PDELATY], + [(np.int64, None, IN), + (np.int64, None, IN), + (np.int64, None, IN), + (np.int64, None, IN), + (np.int64, None, IN), + (np.int64, None, IN), + (np.int64, None, IN), + (np.float64, None, IN), + (np.float64, None, IN), + (np.int64, None, OUT), + (np.int64, None, OUT)], + None) + + +@treatReturnCode +@ctypesFF() +@addReturnCode +def trans_inq4py(KSIZEJ, KTRUNC, KSLOEN, KLOEN, KNUMMAXRESOL): + """ + Simplified wrapper to TRANS_INQ. + + Args:\n + 1) KSIZEJ: number of latitudes in grid-point space + 2) KTRUNC: troncature + 3) KSLOEN: Size of KLOEN + 4) KLOEN: number of points on each latitude row + 5) KNUMMAXRESOL: maximum number of troncatures handled + + Returns:\n + 1) KGPTOT: number of gridpoints + 2) KSPEC: number of spectral coefficients + 3) KNMENG: cut-off zonal wavenumber + """ + return ([KSIZEJ, KTRUNC, KSLOEN, KLOEN, KNUMMAXRESOL], + [(np.int64, None, IN), + (np.int64, None, IN), + (np.int64, None, IN), + (np.int64, (KSLOEN,), IN), + (np.int64, None, IN), + (np.int64, None, OUT), + (np.int64, None, OUT), + (np.int64, (KSLOEN,), OUT)], + None) + + +@treatReturnCode +@ctypesFF() +@addReturnCode +def sp2gp_lam4py(KSIZEI, KSIZEJ, + KPHYSICALSIZEI, KPHYSICALSIZEJ, + KTRUNCX, KTRUNCY, + KNUMMAXRESOL, + KSIZE, + LGRADIENT, + LREORDER, + PDELTAX, PDELTAY, + PSPEC): + """ + Transform spectral coefficients into grid-point values. + + Args:\n + 1,2) KSIZEI, KSIZEJ: size of grid-point field (with extension zone) + 3,4) KPHYSICALSIZEI, KPHYSICALSIZEJ: size of physical part of grid-point field + 5,6) KTRUNCX, KTRUNCY: troncatures + 7) KNUMMAXRESOL: maximum number of troncatures handled + 8) KSIZE: size of PSPEC + 9) LGRADIENT: gradient computation + 10) LREORDER: reorder spectral coefficients or not + 11,12) PDELTAX,PDELTAY: resolution along x,y axis + 13) PSPEC: spectral coefficient array + + Returns:\n + 1) PGPT: grid-point field + 2) PGPTM: N-S derivative if LGRADIENT + 3) PGPTL: E-W derivative if LGRADIENT + """ + return ([KSIZEI, KSIZEJ, + KPHYSICALSIZEI, KPHYSICALSIZEJ, + KTRUNCX, KTRUNCY, + KNUMMAXRESOL, + KSIZE, + LGRADIENT, + LREORDER, + PDELTAX, PDELTAY, + PSPEC], + [(np.int64, None, IN), + (np.int64, None, IN), + (np.int64, None, IN), + (np.int64, None, IN), + (np.int64, None, IN), + (np.int64, None, IN), + (np.int64, None, IN), + (np.int64, None, IN), + (bool, None, IN), + (bool, None, IN), + (np.float64, None, IN), + (np.float64, None, IN), + (np.float64, (KSIZE,), IN), + (np.float64, (KSIZEI * KSIZEJ,), OUT), + (np.float64, (KSIZEI * KSIZEJ,), OUT), + (np.float64, (KSIZEI * KSIZEJ,), OUT)], + None) + + +@treatReturnCode +@ctypesFF() +@addReturnCode +def gp2sp_lam4py(KSIZE, + KSIZEI, KSIZEJ, + KPHYSICALSIZEI, KPHYSICALSIZEJ, + KTRUNCX, KTRUNCY, + KNUMMAXRESOL, + PDELTAX, PDELTAY, + LREORDER, + PGPT): + """ + Transform grid point values into spectral coefficients. + + Args:\n + 1) KSIZE: size of spectral field + 2,3) KSIZEI, KSIZEJ: size of grid-point field (with extension zone) + 4,5) KPHYSICALSIZEI, KPHYSICALSIZEJ: size of physical part of grid-point field + 6,7) KTRUNCX, KTRUNCY: troncatures + 8) KNUMMAXRESOL: maximum number of troncatures handled + 9,10) PDELTAX, PDELTAY: resolution along x,y axis + 11) LREORDER: reorder spectral coefficients or not + 12) PGPT: grid-point field + + Returns:\n + 1) PSPEC: spectral coefficient array + """ + return ([KSIZE, + KSIZEI, KSIZEJ, + KPHYSICALSIZEI, KPHYSICALSIZEJ, + KTRUNCX, KTRUNCY, + KNUMMAXRESOL, + PDELTAX, PDELTAY, + LREORDER, + PGPT], + [(np.int64, None, IN), + (np.int64, None, IN), + (np.int64, None, IN), + (np.int64, None, IN), + (np.int64, None, IN), + (np.int64, None, IN), + (np.int64, None, IN), + (np.int64, None, IN), + (np.float64, None, IN), + (np.float64, None, IN), + (bool, None, IN), + (np.float64, (KSIZEI * KSIZEJ,), IN), + (np.float64, (KSIZE,), OUT)], + None) + + +@treatReturnCode +@ctypesFF() +@addReturnCode +def sp2gp_gauss4py(KSIZEJ, + KTRUNC, + KNUMMAXRESOL, + KGPTOT, + KSLOEN, + KLOEN, + KSIZE, + LGRADIENT, + LREORDER, + PSPEC): + """ + Transform spectral coefficients into grid-point values. + + Args:\n + 1) KSIZEJ: Number of latitudes + 2) KTRUNC: troncature + 3) KNUMMAXRESOL: maximum number of troncatures handled + 4) KGPTOT: number of grid-points + 5) KSLOEN: Size of KLOEN + 6) KLOEN: + 7) KSIZE: Size of PSPEC + 8) LGRADIENT: compute derivatives + 9) LREORDER: reorder spectral coefficients or not + 10) PSPEC: spectral coefficient array + + Returns:\n + 1) PGPT: grid-point field + 2) PGPTM: N-S derivative if LGRADIENT + 3) PGPTL: E-W derivative if LGRADIENT + """ + return ([KSIZEJ, + KTRUNC, + KNUMMAXRESOL, + KGPTOT, + KSLOEN, + KLOEN, + KSIZE, + LGRADIENT, + LREORDER, + PSPEC], + [(np.int64, None, IN), + (np.int64, None, IN), + (np.int64, None, IN), + (np.int64, None, IN), + (np.int64, None, IN), + (np.int64, (KSLOEN,), IN), + (np.int64, None, IN), + (bool, None, IN), + (bool, None, IN), + (np.float64, (KSIZE,), IN), + (np.float64, (KGPTOT,), OUT), + (np.float64, (KGPTOT,), OUT), + (np.float64, (KGPTOT,), OUT)], + None) + + +@treatReturnCode +@ctypesFF() +@addReturnCode +def gp2sp_gauss4py(KSPEC, + KSIZEJ, + KTRUNC, + KNUMMAXRESOL, + KSLOEN, + KLOEN, + KSIZE, + LREORDER, + PGPT): + """ + Transform grid-point values into spectral coefficients. + + Args:\n + 1) KSPEC: size of spectral coefficients array + 2) KSIZEJ: Number of latitudes + 3) KTRUNC: troncature + 4) KNUMMAXRESOL: maximum number of troncatures handled + 5) KSLOEN: Size of KLOEN + 6) KLOEN + 7) KSIZE: Size of PGPT + 8) LREORDER: reorder spectral coefficients or not + 9) PGPT: grid-point field + + Returns:\n + 1) PSPEC: spectral coefficient array + """ + return ([KSPEC, + KSIZEJ, + KTRUNC, + KNUMMAXRESOL, + KSLOEN, + KLOEN, + KSIZE, + LREORDER, + PGPT], + [(np.int64, None, IN), + (np.int64, None, IN), + (np.int64, None, IN), + (np.int64, None, IN), + (np.int64, None, IN), + (np.int64, (KSLOEN,), IN), + (np.int64, None, IN), + (bool, None, IN), + (np.float64, (KSIZE,), IN), + (np.float64, (KSPEC,), OUT)], + None) + + +@ctypesFF() +def sp2gp_fft1d4py(KSIZES, KTRUNC, PSPEC, KSIZEG): + """ + Transform spectral coefficients into grid-point values, + for a 1D array (vertical section academic model) + + Args:\n + 1) KSIZES size of PSPEC + 2) KTRUNC: troncature + 3) PSPEC: spectral coefficient array + 4) KSIZEG: size of grid-point field (with extension zone) + + Returns:\n + 1) PGPT: grid-point field + """ + return ([KSIZES, KTRUNC, PSPEC, KSIZEG], + [(np.int64, None, IN), + (np.int64, None, IN), + (np.float64, (KSIZES,), IN), + (np.int64, None, IN), + (np.float64, (KSIZEG,), OUT)], + None) diff --git a/src/ectrans4py/etrans_inq4py.F90 b/src/ectrans4py/etrans_inq4py.F90 new file mode 100644 index 000000000..7f2113fba --- /dev/null +++ b/src/ectrans4py/etrans_inq4py.F90 @@ -0,0 +1,66 @@ +SUBROUTINE ETRANS_INQ4PY(KRETURNCODE, KSIZEI, KSIZEJ, KPHYSICALSIZEI, KPHYSICALSIZEJ, & + &KTRUNCX, KTRUNCY, KNUMMAXRESOL, PDELTAX, PDELTAY, & + &KGPTOT, KSPEC) +! ** PURPOSE +! Simplified wrapper to ETRANS_INQ +! +! ** DUMMY ARGUMENTS +! KSIZEI, KSIZEJ: size of grid-point field (with extension zone) +! KPHYSICALSIZEI, KPHYSICALSIZEJ: size of physical part of grid-point field +! KTRUNCX, KTRUNCY: troncatures +! KNUMMAXRESOL: maximum number of troncatures handled +! PDELTAX: x resolution +! PDELTAY: y resolution +! KGPTOT: number of gridpoints +! KSPEC: number of spectral coefficients +! +! ** AUTHOR +! 9 April 2014, S. Riette +! +! ** MODIFICATIONS +! 6 Jan., S. Riette: PDELTAX and PDELTAY added +! +! I. Dummy arguments declaration +IMPLICIT NONE +INTEGER(KIND=8), INTENT(OUT) :: KRETURNCODE +INTEGER(KIND=8), INTENT(IN) :: KSIZEI, KSIZEJ +INTEGER(KIND=8), INTENT(IN) :: KPHYSICALSIZEI, KPHYSICALSIZEJ +INTEGER(KIND=8), INTENT(IN) :: KTRUNCX, KTRUNCY +INTEGER(KIND=8), INTENT(IN) :: KNUMMAXRESOL +REAL(KIND=8), INTENT(IN) :: PDELTAX +REAL(KIND=8), INTENT(IN) :: PDELTAY +INTEGER(KIND=8), INTENT(OUT) :: KGPTOT +INTEGER(KIND=8), INTENT(OUT) :: KSPEC +! +! II. Local variables declaration +INTEGER, DIMENSION(0:KTRUNCX) :: IESM0 +INTEGER :: ISIZEI, ISIZEJ, & + & IPHYSICALSIZEI, IPHYSICALSIZEJ, & + & ITRUNCX, ITRUNCY, & + & INUMMAXRESOL +LOGICAL :: LLSTOP +INTEGER :: IIDENTRESOL +INTEGER, DIMENSION(1) :: ILOEN +INTEGER :: IGPTOT, ISPEC + +#include "etrans_inq.h" + +ISIZEI=KSIZEI +ISIZEJ=KSIZEJ +IPHYSICALSIZEI=KPHYSICALSIZEI +IPHYSICALSIZEJ=KPHYSICALSIZEJ +ITRUNCX=KTRUNCX +ITRUNCY=KTRUNCY +INUMMAXRESOL=KNUMMAXRESOL + +! III. Setup +CALL SPEC_SETUP4PY(KRETURNCODE, ISIZEI, ISIZEJ, IPHYSICALSIZEI, IPHYSICALSIZEJ, & + &ITRUNCX, ITRUNCY, INUMMAXRESOL, ILOEN, .TRUE., 1, & + &PDELTAX, PDELTAY, IIDENTRESOL, LLSTOP) +IF (.NOT. LLSTOP) THEN + CALL ETRANS_INQ(KRESOL=IIDENTRESOL, KGPTOT=IGPTOT, KSPEC=ISPEC, KESM0=IESM0) + KGPTOT=IGPTOT + KSPEC=ISPEC +ENDIF +! +END SUBROUTINE ETRANS_INQ4PY diff --git a/src/ectrans4py/gp2sp_gauss4py.F90 b/src/ectrans4py/gp2sp_gauss4py.F90 new file mode 100644 index 000000000..76fff02c8 --- /dev/null +++ b/src/ectrans4py/gp2sp_gauss4py.F90 @@ -0,0 +1,113 @@ +SUBROUTINE GP2SP_GAUSS4PY(KRETURNCODE, KSPEC, KSIZEJ, KTRUNC, KNUMMAXRESOL, KSLOEN, KLOEN, KSIZE, LREORDER, PGPT, PSPEC) +! ** PURPOSE +! Transform spectral coefficients into grid-point values +! +! ** DUMMY ARGUMENTS +! KRETURNCODE: error code +! KSPEC: size of spectral coefficients array +! KSIZEJ: Number of latitudes +! KTRUNC: troncature +! KNUMMAXRESOL: maximum number of troncatures handled +! KSLOEN: Size ok KLOEN +! KLOEN +! KSIZE: Size of PGPT +! LREORDER: switch to reorder spectral coefficients or not +! PGPT: grid-point field +! PSPEC: spectral coefficient array +! +! ** AUTHOR +! 9 April 2014, S. Riette +! +! ** MODIFICATIONS +! 6 Jan. 2016, S. Riette: w_spec_setup interface modified +! March, 2016, A.Mary: LREORDER +! +! I. Dummy arguments declaration +USE PARKIND1, ONLY : JPRB +IMPLICIT NONE +INTEGER(KIND=8), INTENT(OUT) :: KRETURNCODE +INTEGER(KIND=8), INTENT(IN) :: KSPEC +INTEGER(KIND=8), INTENT(IN) :: KSIZEJ +INTEGER(KIND=8), INTENT(IN) :: KTRUNC +INTEGER(KIND=8), INTENT(IN) :: KNUMMAXRESOL +INTEGER(KIND=8), INTENT(IN) :: KSLOEN +INTEGER(KIND=8), DIMENSION(KSLOEN), INTENT(IN) :: KLOEN +INTEGER(KIND=8), INTENT(IN) :: KSIZE +LOGICAL, INTENT(IN) :: LREORDER +REAL(KIND=8), DIMENSION(KSIZE), INTENT(IN) :: PGPT +REAL(KIND=8), DIMENSION(KSPEC), INTENT(OUT) :: PSPEC +! +! II. Local variables declaration +INTEGER, DIMENSION(SIZE(KLOEN)) :: ILOEN +INTEGER :: ISIZEI, ISIZEJ, & + & IPHYSICALSIZEI, IPHYSICALSIZEJ, & + & ITRUNCX, ITRUNCY, & + & INUMMAXRESOL +LOGICAL :: LLSTOP +INTEGER :: IIDENTRESOL +INTEGER :: JI, JM, JN +INTEGER, DIMENSION(0:KTRUNC) :: NASM0 +REAL(KIND=JPRB), DIMENSION(1, SIZE(PGPT)) :: ZSPBUF !size over-evaluated +REAL(KIND=JPRB), DIMENSION(SIZE(PGPT), 1, 1) :: ZGPBUF +REAL(KIND=8) :: ZDELTAX, ZDELTAY + +#include "trans_inq.h" +#include "dir_trans.h" +KRETURNCODE=0 +ILOEN(:)=KLOEN(:) +ISIZEI=0 +ISIZEJ=KSIZEJ +IPHYSICALSIZEI=0 +IPHYSICALSIZEJ=0 +ITRUNCX=KTRUNC +ITRUNCY=0 +INUMMAXRESOL=KNUMMAXRESOL +! +! III. Setup +ZDELTAX=0. +ZDELTAY=0. +CALL SPEC_SETUP4PY(KRETURNCODE, ISIZEI, ISIZEJ, IPHYSICALSIZEI, IPHYSICALSIZEJ, & + &ITRUNCX, ITRUNCY, INUMMAXRESOL, ILOEN, .FALSE., SIZE(ILOEN), & + &ZDELTAX, ZDELTAY, IIDENTRESOL, LLSTOP) +! +! IV. Transformation +! IV.a Shape of coefficient array +IF (.NOT. LLSTOP) THEN + JI=1 + DO JN=0, KTRUNC + NASM0(JN)=JI + JI=JI+1+JN+(JN+1) + ENDDO +ENDIF + +! IV.b Direct transform +IF (.NOT. LLSTOP) THEN + ZGPBUF(:,1,1)=REAL(PGPT(:),KIND=JPRB) + CALL DIR_TRANS(PSPSCALAR=ZSPBUF(:,:), PGP=ZGPBUF(:,:,:), KRESOL=IIDENTRESOL) +ENDIF + +! IV.c Reordering +IF (LREORDER) THEN + IF(.NOT. LLSTOP) THEN + PSPEC(:)=0. + JI=1 + DO JM=0, KTRUNC + DO JN=JM, KTRUNC + PSPEC(NASM0(JN)+JM)=REAL(ZSPBUF(1,JI),KIND=8) + JI=JI+1 + IF(JM/=0) THEN + PSPEC(NASM0(JN)-JM)=REAL(ZSPBUF(1,JI),KIND=8) + ENDIF + JI=JI+1 + ENDDO + ENDDO + IF(JI-1/=KSPEC) THEN + PRINT*, "Internal error in GP2SP_GAUSS4PY (spectral reordering)" + KRETURNCODE=-999 + ENDIF + ENDIF +ELSE + PSPEC(1:KSPEC) = REAL(ZSPBUF(1,1:KSPEC),KIND=8) +ENDIF + +END SUBROUTINE GP2SP_GAUSS4PY diff --git a/src/ectrans4py/gp2sp_lam4py.f90 b/src/ectrans4py/gp2sp_lam4py.f90 new file mode 100644 index 000000000..036a4674b --- /dev/null +++ b/src/ectrans4py/gp2sp_lam4py.f90 @@ -0,0 +1,121 @@ +SUBROUTINE GP2SP_LAM4PY(KRETURNCODE, KSIZE, KSIZEI, KSIZEJ, KPHYSICALSIZEI, KPHYSICALSIZEJ, & + &KTRUNCX, KTRUNCY, KNUMMAXRESOL, PDELTAX, PDELTAY, LREORDER, PGPT, PSPEC) +! ** PURPOSE +! Transform grid point values into spectral coefficients +! +! ** DUMMY ARGUMENTS +! KRETURNCODE: error code +! KSIZE: size of spectral field +! KSIZEI, KSIZEJ: size of grid-point field (with extension zone) +! KPHYSICALSIZEI, KPHYSICALSIZEJ: size of physical part of grid-point field +! KTRUNCX, KTRUNCY: troncatures +! KNUMMAXRESOL: maximum number of troncatures handled +! PDELTAX: x resolution +! PDELTAY: y resolution +! LREORDER: switch to reorder spectral coefficients or not +! PGPT: grid-point field +! PSPEC: spectral coefficient array +! +! ** AUTHOR +! 9 April 2014, S. Riette +! +! ** MODIFICATIONS +! 6 Jan., S. Riette: PDELTAX and PDELTAY added +! March, 2016, A.Mary: LREORDER +! +! I. Dummy arguments declaration +USE PARKIND1, ONLY : JPRB +IMPLICIT NONE +INTEGER(KIND=8), INTENT(OUT) :: KRETURNCODE +INTEGER(KIND=8), INTENT(IN) :: KSIZE, KSIZEI, KSIZEJ +INTEGER(KIND=8), INTENT(IN) :: KPHYSICALSIZEI, KPHYSICALSIZEJ +INTEGER(KIND=8), INTENT(IN) :: KTRUNCX, KTRUNCY +INTEGER(KIND=8), INTENT(IN) :: KNUMMAXRESOL +REAL(KIND=8), INTENT(IN) :: PDELTAX +REAL(KIND=8), INTENT(IN) :: PDELTAY +LOGICAL, INTENT(IN) :: LREORDER +REAL(KIND=8), DIMENSION(KSIZEI*KSIZEJ), INTENT(IN) :: PGPT +REAL(KIND=8), DIMENSION(KSIZE), INTENT(OUT) :: PSPEC +! +! II. Local variables declaration +INTEGER, DIMENSION(0:KTRUNCX) :: IESM0 +INTEGER :: IGPTOT, ISPEC +INTEGER, DIMENSION(0:KTRUNCY) :: ISPECINI, ISPECEND +REAL(KIND=JPRB), DIMENSION(1, KSIZEI*KSIZEJ) :: ZSPBUF !size over-evaluated +REAL(KIND=JPRB), DIMENSION(KSIZEI*KSIZEJ, 1, 1) :: ZGPBUF +INTEGER :: JI, JM, JN, IIDENTRESOL +LOGICAL :: LLSTOP +INTEGER :: ISIZEI, ISIZEJ, & + & IPHYSICALSIZEI, IPHYSICALSIZEJ, & + & ITRUNCX, ITRUNCY, & + & INUMMAXRESOL +INTEGER, DIMENSION(1) :: ILOEN + +#include "edir_trans.h" +#include "etrans_inq.h" + +KRETURNCODE=0 +LLSTOP=.FALSE. +ISIZEI=KSIZEI +ISIZEJ=KSIZEJ +IPHYSICALSIZEI=KPHYSICALSIZEI +IPHYSICALSIZEJ=KPHYSICALSIZEJ +ITRUNCX=KTRUNCX +ITRUNCY=KTRUNCY +INUMMAXRESOL=KNUMMAXRESOL + +! III. Setup +CALL SPEC_SETUP4PY(KRETURNCODE, ISIZEI, ISIZEJ, IPHYSICALSIZEI, IPHYSICALSIZEJ, & + &ITRUNCX, ITRUNCY, INUMMAXRESOL, ILOEN, .TRUE., 1, & + &PDELTAX, PDELTAY, IIDENTRESOL, LLSTOP) + +! IV. Transformation + +! IV.a Shape of coefficient array +!IGPTOT is the total number of points in grid-point space +!ISPEC is the number of spectral coefficients +!IESM0(m) is the index of spectral coefficient (m,0) in model +!ISPECINI(n) is the index of the first of the 4 spectral coefficient (0,n) in FA file +!ISPECEND(n) is the index of the last of the last 4 spectral coefficients (:,n) in FA file +IF (.NOT. LLSTOP) THEN + CALL ETRANS_INQ(KRESOL=IIDENTRESOL, KGPTOT=IGPTOT, KSPEC=ISPEC, KESM0=IESM0) + JI=1 + DO JN=0, ITRUNCY + ISPECINI(JN)=(JI-1)*4+1 + JI=JI+COUNT(IESM0(1:ITRUNCX)-IESM0(0:ITRUNCX-1)>JN*4) + IF (ISPEC-IESM0(ITRUNCX)>JN*4) JI=JI+1 + ISPECEND(JN)=(JI-1)*4 + ENDDO +ENDIF + +! III.b transform +IF (.NOT. LLSTOP) THEN + ZGPBUF(:,1,1)=REAL(PGPT(:),KIND=JPRB) + CALL EDIR_TRANS(PSPSCALAR=ZSPBUF(:,:), PGP=ZGPBUF(:,:,:), KRESOL=IIDENTRESOL) +ENDIF + +! III.c Reordering +! reorder Aladin : file ordering = coeffs per blocks of m, 4 reals per coeff +! Aladin array ordering = coeffs per blocks of n, 4 reals per coeff +IF (LREORDER) THEN + IF (.NOT. LLSTOP) THEN + JI=1 + PSPEC(:)=0. + DO JM=0,ITRUNCX*4+4,4 + DO JN=0,ITRUNCY + IF (ISPECINI(JN)+JM+3<=ISPECEND(JN)) THEN + PSPEC(ISPECINI(JN)+JM:ISPECINI(JN)+JM+3) = REAL(ZSPBUF(1,JI:JI+3),KIND=8) + JI=JI+4 + ENDIF + ENDDO + ENDDO + IF(JI/=ISPEC+1) THEN + PRINT*, "Internal error in GP2SP_LAM4PY (spectral reordering)" + KRETURNCODE=-999 + ENDIF + ENDIF +ELSE + PSPEC(1:KSIZE) = REAL(ZSPBUF(1,1:KSIZE),KIND=8) +ENDIF + +END SUBROUTINE GP2SP_LAM4PY diff --git a/src/ectrans4py/sp2gp_fft1d4py.F90 b/src/ectrans4py/sp2gp_fft1d4py.F90 new file mode 100644 index 000000000..060f14f4d --- /dev/null +++ b/src/ectrans4py/sp2gp_fft1d4py.F90 @@ -0,0 +1,114 @@ +SUBROUTINE SP2GP_FFT1D4PY(KSIZES, KTRUNC, PSPEC, KSIZEG, PGPT) +! ** PURPOSE +! Transform spectral coefficients into grid-point values, +! for a 1D array (vertical section academic model) +! +! ** DUMMY ARGUMENTS +! KSIZES size of PSPEC +! KTRUNC: troncature +! PSPEC: spectral coefficient array +! KSIZEG: size of grid-point field (with extension zone) +! PGPT: grid-point field +! +! ** AUTHOR +! 26 March 2015, A. Mary, from utilities/pinuts/module/fa_datas_mod.F90 +! +! ** MODIFICATIONS +! +! I. Dummy arguments declaration +IMPLICIT NONE + +INTEGER(KIND=8), INTENT(IN) :: KSIZES +INTEGER(KIND=8), INTENT(IN) :: KTRUNC +REAL(KIND=8), DIMENSION(KSIZES), INTENT(IN) :: PSPEC +INTEGER(KIND=8), INTENT(IN) :: KSIZEG +REAL(KIND=8), DIMENSION(KSIZEG), INTENT(OUT) :: PGPT + +INTEGER(KIND=8) :: NSEFRE, NFTM, NDGLSUR +REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: SP2, TRIGSE +INTEGER(KIND=8), DIMENSION(:), ALLOCATABLE :: NFAXE +INTEGER(KIND=8), PARAMETER :: NZERO=0 + +NDGLSUR = KSIZEG+MOD(KSIZEG,2)+2 +NFTM = 2*(KTRUNC+1) +ALLOCATE(SP2(NDGLSUR*NFTM)) +SP2 = 0.0 +SP2 = CONVRT2FFT(PSPEC,NZERO,KTRUNC,NDGLSUR) +ALLOCATE(NFAXE(1:10)) +ALLOCATE(TRIGSE(1:KSIZEG)) +CALL SET99(TRIGSE,NFAXE,KSIZEG) +CALL FFT992(SP2(1:KSIZEG), TRIGSE, NFAXE, 1, NDGLSUR, KSIZEG, 1, 1) +DEALLOCATE(TRIGSE) +DEALLOCATE(NFAXE) +PGPT(:) = SP2(1:KSIZEG) + +CONTAINS + +! from utilities/pinuts/module/fa_datas_mod.F90 +! and utilities/pinuts/module/array_lib_mod.F90 + +FUNCTION CONVRT2FFT(IN,X,Y,N) RESULT(OU) +REAL(KIND=8),DIMENSION(:),INTENT(IN) :: IN +INTEGER(KIND=8),INTENT(IN) :: X, Y, N +REAL(KIND=8),DIMENSION(N*2*(X+1)) :: OU + +INTEGER(KIND=8),DIMENSION(2*(X+1),(N/2)) :: MINQ +INTEGER(KIND=8),DIMENSION((N/2),2*(X+1)) :: TMINQ +REAL(KIND=8),DIMENSION(2*(X+1),(N/2)) :: OMINQ, EMINQ +REAL(KIND=8),DIMENSION((N/2),2*(X+1)) :: TOMINQ, TEMINQ +REAL(KIND=8),DIMENSION(N*(X+1)) :: OINI, EINI +REAL(KIND=8), PARAMETER :: ZZERO=0.0 + +CALL SPLIT_ODEV(IN,OINI,EINI) +MINQ = MASQ(X,Y,N) +OMINQ = UNPACK(OINI,MINQ == 1,ZZERO) +TOMINQ = TRANSPOSE(OMINQ) +EMINQ = UNPACK(EINI,MINQ == 1,ZZERO) +TEMINQ = TRANSPOSE(EMINQ) +TMINQ = 1 +OINI = PACK(TOMINQ,TMINQ > 0) +EINI = PACK(TEMINQ,TMINQ > 0) +OU = MIX_ODEV(OINI,EINI) +END FUNCTION CONVRT2FFT + +FUNCTION MASQ(X,Y,N) RESULT(T) +INTEGER(KIND=8),INTENT(IN) :: X, Y, N +INTEGER(KIND=8),DIMENSION(1:2*(X+1),1:(N/2)) :: T + +INTEGER(KIND=8) :: I, J +INTEGER(KIND=8),DIMENSION(0:X) :: KM +INTEGER(KIND=8),DIMENSION(0:Y) :: KN +CALL ELLIPS64(X,Y,KN,KM) +T = 0 +DO I=0,Y + DO J=0,2*KN(I)+1 + T(J+1,I+1)=1 + END DO +END DO +END FUNCTION MASQ + +FUNCTION MIX_ODEV(TO,TE) RESULT(T) +REAL(KIND=8),DIMENSION(:),INTENT(IN) :: TO,TE +REAL(KIND=8),DIMENSION(SIZE(TO)+SIZE(TE)) :: T + +INTEGER(KIND=8) :: I + +DO I=1,(SIZE(TO)+SIZE(TE))/2 + T((2*I)-1)=TE(I) + T(2*I)=TO(I) +END DO +END FUNCTION MIX_ODEV + +SUBROUTINE SPLIT_ODEV(T,TO,TE) +REAL(KIND=8),DIMENSION(:),INTENT(IN) :: T +REAL(KIND=8),DIMENSION(SIZE(T)/2),INTENT(OUT) :: TO,TE + +INTEGER(KIND=8) :: I + +DO I=1,SIZE(T)/2 + TO(I)=T(2*I) + TE(I)=T((2*I)-1) +END DO +END SUBROUTINE SPLIT_ODEV + +END SUBROUTINE SP2GP_FFT1D4PY \ No newline at end of file diff --git a/src/ectrans4py/sp2gp_gauss4py.F90 b/src/ectrans4py/sp2gp_gauss4py.F90 new file mode 100644 index 000000000..61186f53f --- /dev/null +++ b/src/ectrans4py/sp2gp_gauss4py.F90 @@ -0,0 +1,123 @@ +SUBROUTINE SP2GP_GAUSS4PY(KRETURNCODE, KSIZEJ, KTRUNC, KNUMMAXRESOL, KGPTOT, KSLOEN, KLOEN, KSIZE, & + & LGRADIENT, LREORDER, PSPEC, PGPT, PGPTM, PGPTL) +! ** PURPOSE +! Transform spectral coefficients into grid-point values +! +! ** DUMMY ARGUMENTS +! KSIZEJ: Number of latitudes +! KTRUNC: troncature +! KNUMMAXRESOL: maximum number of troncatures handled +! KGPTOT: number of grid-points +! KSLOEN: Size of KLOEN +! KLOEN: +! KSIZE: Size of PSPEC +! LREORDER: switch to reorder spectral coefficients or not +! LGRADIENT: switch to compute or not gradient +! PSPEC: spectral coefficient array +! PGPT: grid-point field +! PGPTM: N-S derivative if LGRADIENT +! PGPTL: E-W derivative if LGRADIENT +! +! ** AUTHOR +! 9 April 2014, S. Riette +! +! ** MODIFICATIONS +! 6 Jan., S. Riette: w_spec_setup interface modified +! March, 2016, A.Mary: LREORDER +! Sept., 2016, A.Mary: LGRADIENT +! +! I. Dummy arguments declaration +USE PARKIND1, ONLY : JPRB +IMPLICIT NONE +INTEGER(KIND=8), INTENT(OUT) :: KRETURNCODE +INTEGER(KIND=8), INTENT(IN) :: KSIZEJ +INTEGER(KIND=8), INTENT(IN) :: KTRUNC +INTEGER(KIND=8), INTENT(IN) :: KNUMMAXRESOL +INTEGER(KIND=8), INTENT(IN) :: KGPTOT +INTEGER(KIND=8), INTENT(IN) :: KSLOEN +INTEGER(KIND=8), DIMENSION(KSLOEN), INTENT(IN) :: KLOEN +INTEGER(KIND=8), INTENT(IN) :: KSIZE +LOGICAL, INTENT(IN) :: LGRADIENT +LOGICAL, INTENT(IN) :: LREORDER +REAL(KIND=8), DIMENSION(KSIZE), INTENT(IN) :: PSPEC +REAL(KIND=8), DIMENSION(KGPTOT), INTENT(OUT) :: PGPT +REAL(KIND=8), DIMENSION(KGPTOT), INTENT(OUT) :: PGPTM +REAL(KIND=8), DIMENSION(KGPTOT), INTENT(OUT) :: PGPTL +! +! II. Local variables declaration +INTEGER, DIMENSION(SIZE(KLOEN)) :: ILOEN +INTEGER :: ISIZEI, ISIZEJ, & + & IPHYSICALSIZEI, IPHYSICALSIZEJ, & + & ITRUNCX, ITRUNCY, & + & INUMMAXRESOL +LOGICAL :: LLSTOP +INTEGER :: IIDENTRESOL +INTEGER :: JI, JM, JN +INTEGER, DIMENSION(0:KTRUNC) :: NASM0 +REAL(KIND=8), DIMENSION(1, KSIZE) :: ZSPBUF +REAL(KIND=JPRB), DIMENSION(KGPTOT, 3, 1) :: ZGPBUF +REAL(KIND=8) :: ZDELTAX, ZDELTAY +#include "trans_inq.h" +#include "inv_trans.h" + +ILOEN(:)=KLOEN(:) +ISIZEI=0 +ISIZEJ=KSIZEJ +IPHYSICALSIZEI=0 +IPHYSICALSIZEJ=0 +ITRUNCX=KTRUNC +ITRUNCY=0 +INUMMAXRESOL=KNUMMAXRESOL +! +! III. Setup +ZDELTAX=0. +ZDELTAY=0. +CALL SPEC_SETUP4PY(KRETURNCODE, ISIZEI, ISIZEJ, IPHYSICALSIZEI, IPHYSICALSIZEJ, & + &ITRUNCX, ITRUNCY, INUMMAXRESOL, ILOEN, .FALSE., SIZE(ILOEN), & + &ZDELTAX, ZDELTAY, IIDENTRESOL, LLSTOP) +! +! IV. Transformation +IF (LREORDER) THEN + ! IV.a Shape of coefficient array + IF (.NOT. LLSTOP) THEN + JI=1 + DO JN=0, KTRUNC + NASM0(JN)=JI + JI=JI+1+JN+(JN+1) + ENDDO + ENDIF + + ! IV.b Reordering + IF(.NOT. LLSTOP) THEN + ZSPBUF(1,:)=0. + JI=1 + DO JM=0, KTRUNC + DO JN=JM, KTRUNC + ZSPBUF(1,JI)=PSPEC(NASM0(JN)+JM) + JI=JI+1 + IF(JM==0) THEN + ZSPBUF(1,JI)=0 + ELSE + ZSPBUF(1,JI)=PSPEC(NASM0(JN)-JM) + ENDIF + JI=JI+1 + ENDDO + ENDDO + ENDIF +ELSE + ZSPBUF(1,:) = PSPEC(:) +ENDIF + +! IV.c Inverse transform +IF (.NOT. LLSTOP) THEN + IF (.NOT. LGRADIENT) THEN + CALL INV_TRANS(PSPSCALAR=REAL(ZSPBUF(:,:),KIND=JPRB), PGP=ZGPBUF(:,:,:), KRESOL=IIDENTRESOL) + PGPT(:)=REAL(ZGPBUF(:,1,1),KIND=8) + ELSE + CALL INV_TRANS(PSPSCALAR=REAL(ZSPBUF(:,:),KIND=JPRB), PGP=ZGPBUF(:,:,:), KRESOL=IIDENTRESOL, LDSCDERS=.TRUE.) + PGPT(:)=REAL(ZGPBUF(:,1,1),KIND=8) + PGPTM(:)=REAL(ZGPBUF(:,2,1),KIND=8) + PGPTL(:)=REAL(ZGPBUF(:,3,1),KIND=8) + ENDIF +ENDIF +END SUBROUTINE SP2GP_GAUSS4PY diff --git a/src/ectrans4py/sp2gp_lam4py.F90 b/src/ectrans4py/sp2gp_lam4py.F90 new file mode 100644 index 000000000..17657966f --- /dev/null +++ b/src/ectrans4py/sp2gp_lam4py.F90 @@ -0,0 +1,140 @@ +SUBROUTINE SP2GP_LAM4PY(KRETURNCODE, KSIZEI, KSIZEJ, KPHYSICALSIZEI, KPHYSICALSIZEJ, & + &KTRUNCX, KTRUNCY, KNUMMAXRESOL, KSIZE, LGRADIENT, LREORDER, PDELTAX, PDELTAY, & + &PSPEC, PGPT, PGPTM, PGPTL) +! ** PURPOSE +! Transform spectral coefficients into grid-point values +! +! ** DUMMY ARGUMENTS +! KRETURNCODE: error code +! KSIZEI, KSIZEJ: size of grid-point field (with extension zone) +! KPHYSICALSIZEI, KPHYSICALSIZEJ: size of physical part of grid-point field +! KTRUNCX, KTRUNCY: troncatures +! KNUMMAXRESOL: maximum number of troncatures handled +! KSIZE: size of PSPEC +! LREORDER: switch to reorder spectral coefficients or not +! LGRADIENT: switch to compute or not gradient +! PDELTAX: x resolution +! PDELTAY: y resolution +! PSPEC: spectral coefficient array +! PGPT: grid-point field +! PGPTM: N-S derivative if LGRADIENT +! PGPTL: E-W derivative if LGRADIENT +! +! ** AUTHOR +! 9 April 2014, S. Riette +! +! ** MODIFICATIONS +! 5 Jan., S. Riette: PDELTAX, PDELTAY, LGRADIENT, PGPTM and PGPTL added +! March, 2016, A.Mary: LREORDER +! +! I. Dummy arguments declaration +USE PARKIND1, ONLY : JPRB +IMPLICIT NONE +INTEGER(KIND=8), INTENT(OUT) :: KRETURNCODE +INTEGER(KIND=8), INTENT(IN) :: KSIZEI, KSIZEJ +INTEGER(KIND=8), INTENT(IN) :: KPHYSICALSIZEI, KPHYSICALSIZEJ +INTEGER(KIND=8), INTENT(IN) :: KTRUNCX, KTRUNCY +INTEGER(KIND=8), INTENT(IN) :: KNUMMAXRESOL +INTEGER(KIND=8), INTENT(IN) :: KSIZE +LOGICAL, INTENT(IN) :: LGRADIENT +LOGICAL, INTENT(IN) :: LREORDER +REAL(KIND=8), INTENT(IN) :: PDELTAX +REAL(KIND=8), INTENT(IN) :: PDELTAY +REAL(KIND=8), DIMENSION(KSIZE), INTENT(IN) :: PSPEC +REAL(KIND=8), DIMENSION(KSIZEI*KSIZEJ), INTENT(OUT) :: PGPT +REAL(KIND=8), DIMENSION(KSIZEI*KSIZEJ), INTENT(OUT) :: PGPTM +REAL(KIND=8), DIMENSION(KSIZEI*KSIZEJ), INTENT(OUT) :: PGPTL +! +! II. Local variables declaration +INTEGER, DIMENSION(0:KTRUNCX) :: IESM0 +INTEGER :: IGPTOT, ISPEC +INTEGER, DIMENSION(0:KTRUNCY) :: ISPECINI, ISPECEND +REAL(KIND=8), DIMENSION(1, KSIZE) :: ZSPBUF +REAL(KIND=JPRB), DIMENSION(KSIZEI*KSIZEJ, 3, 1) :: ZGPBUF +INTEGER :: JI, JM, JN, IINDEX, IIDENTRESOL +LOGICAL :: LLSTOP +INTEGER :: ISIZEI, ISIZEJ, & + & IPHYSICALSIZEI, IPHYSICALSIZEJ, & + & ITRUNCX, ITRUNCY, & + & INUMMAXRESOL +INTEGER, DIMENSION(1) :: ILOEN + +#include "einv_trans.h" +#include "etrans_inq.h" + +KRETURNCODE=0 +LLSTOP=.FALSE. +ISIZEI=KSIZEI +ISIZEJ=KSIZEJ +IPHYSICALSIZEI=KPHYSICALSIZEI +IPHYSICALSIZEJ=KPHYSICALSIZEJ +ITRUNCX=KTRUNCX +ITRUNCY=KTRUNCY +INUMMAXRESOL=KNUMMAXRESOL +ILOEN(:)=0 + +! III. Setup +CALL SPEC_SETUP4PY(KRETURNCODE, ISIZEI, ISIZEJ, IPHYSICALSIZEI, IPHYSICALSIZEJ, & + &ITRUNCX, ITRUNCY, INUMMAXRESOL, ILOEN, .TRUE., 1, & + &PDELTAX, PDELTAY, IIDENTRESOL, LLSTOP) + +! IV. Transformation + +! IV.a Shape of coefficient array +!IGPTOT is the total number of points in grid-point space +!ISPEC is the number of spectral coefficients +!IESM0(m) is the index of spectral coefficient (m,0) in model +!ISPECINI(n) is the index of the first of the 4 spectral coefficient (0,n) in FA file +!ISPECEND(n) is the index of the last of the last 4 spectral coefficients (:,n) in FA file +IF (.NOT. LLSTOP) THEN + CALL ETRANS_INQ(KRESOL=IIDENTRESOL, KGPTOT=IGPTOT, KSPEC=ISPEC, KESM0=IESM0) + JI=1 + DO JN=0, ITRUNCY + ISPECINI(JN)=(JI-1)*4+1 + JI=JI+COUNT(IESM0(1:ITRUNCX)-IESM0(0:ITRUNCX-1)>JN*4) + IF (ISPEC-IESM0(ITRUNCX)>JN*4) JI=JI+1 + ISPECEND(JN)=(JI-1)*4 + ENDDO +ENDIF + +! III.b Reordering +! reorder Aladin : file ordering = coeffs per blocks of m, 4 reals per coeff +! Aladin array ordering = coeffs per blocks of n, 4 reals per coeff +IF (LREORDER) THEN + IF (.NOT. LLSTOP) THEN + ZSPBUF(:,:)=0. + JI=1 + DO JM=0,ITRUNCX+1 + DO JN=0,ITRUNCY + IF (ISPECINI(JN)+JM*4+3<=ISPECEND(JN)) THEN + DO IINDEX=ISPECINI(JN)+JM*4, ISPECINI(JN)+JM*4+3 + ZSPBUF(1,JI)=PSPEC(IINDEX) + JI=JI+1 + ENDDO + ENDIF + ENDDO + ENDDO + IF (JI/=ISPEC+1) THEN + PRINT*, "Internal error in SP2GP_LAM4PY (spectral reordering)" + KRETURNCODE=-999 + LLSTOP=.TRUE. + ENDIF + ENDIF +ELSE + ZSPBUF(1,:) = PSPEC(:) +ENDIF + +! III.c Inverse transform +IF (.NOT. LLSTOP) THEN + IF (.NOT. LGRADIENT) THEN + CALL EINV_TRANS(PSPSCALAR=REAL(ZSPBUF(:,:),KIND=JPRB), PGP=ZGPBUF(:,:,:), KRESOL=IIDENTRESOL) + PGPT(:)=REAL(ZGPBUF(:,1,1),KIND=8) + ELSE + CALL EINV_TRANS(PSPSCALAR=REAL(ZSPBUF(:,:),KIND=JPRB), PGP=ZGPBUF(:,:,:), KRESOL=IIDENTRESOL, LDSCDERS=.TRUE.) + PGPT(:)=REAL(ZGPBUF(:,1,1),KIND=8) + PGPTM(:)=REAL(ZGPBUF(:,2,1),KIND=8) + PGPTL(:)=REAL(ZGPBUF(:,3,1),KIND=8) + ENDIF +ENDIF + +END SUBROUTINE SP2GP_LAM4PY diff --git a/src/ectrans4py/spec_setup4py.F90 b/src/ectrans4py/spec_setup4py.F90 new file mode 100644 index 000000000..644962e3a --- /dev/null +++ b/src/ectrans4py/spec_setup4py.F90 @@ -0,0 +1,160 @@ +SUBROUTINE SPEC_SETUP4PY(KRETURNCODE, KSIZEI, KSIZEJ, KPHYSICALSIZEI, KPHYSICALSIZEJ, & + &KTRUNCX, KTRUNCY, KNUMMAXRESOL, KLOEN, LDLAM, & + &KSIZEKLOEN, PDELTAX, PDELTAY, & + &KIDENTRESOL, LDSTOP) +! ** PURPOSE +! Setup spectral transform for LAM and global +! +! ** DUMMY ARGUMENTS +! KRETURNCODE: error code +! KSIZEI, KSIZEJ: size of grid-point field (with extension zone for LAM), put max size for KSIZEI in global +! KPHYSICALSIZEI, KPHYSICALSIZEJ: size of physical part of grid-point field for LAM (put 0 for global) +! KTRUNCX, KTRUNCY: troncatures for LAM (only KTRUNCX is used for global, put 0 for KTRUNCY) +! KNUMMAXRESOL: maximum number of troncatures handled +! KLOEN: number of points on each latitude row +! KSIZEKLOEN: size of KLOEN array +! PDELTAX: x resolution +! PDELTAY: y resolution +! LDLAM: LAM (.TRUE.) or global (.FALSE.) +! KIDENTRESOL: identification of resolution +! LDSTOP: exception raised? +! +! ** AUTHOR +! 9 April 2014, S. Riette +! +! ** MODIFICATIONS +! 6 Jan 2016, S. Riette: PDELTAX and PDELTAY added +! 31 Jan 2019 R. El Khatib fix for single precision compilation +! +! I. Dummy arguments declaration +USE PARKIND1, ONLY : JPRB +IMPLICIT NONE +INTEGER(KIND=8), INTENT(OUT) :: KRETURNCODE +INTEGER, INTENT(IN) :: KSIZEI, KSIZEJ +INTEGER, INTENT(IN) :: KPHYSICALSIZEI, KPHYSICALSIZEJ +INTEGER, INTENT(IN) :: KTRUNCX, KTRUNCY +INTEGER, INTENT(IN) :: KNUMMAXRESOL +INTEGER, DIMENSION(KSIZEKLOEN), INTENT(IN) :: KLOEN +LOGICAL, INTENT(IN) :: LDLAM +INTEGER, INTENT(IN) :: KSIZEKLOEN +REAL(KIND=8), INTENT(IN) :: PDELTAX +REAL(KIND=8), INTENT(IN) :: PDELTAY +INTEGER, INTENT(OUT) :: KIDENTRESOL +LOGICAL, INTENT(OUT) :: LDSTOP +! +! II. Local variables declaration +INTEGER, DIMENSION(2*KSIZEJ) :: ILOEN +INTEGER :: JI +LOGICAL, SAVE :: LLFIRSTCALL=.TRUE. +LOGICAL :: LLNEWRESOL +INTEGER, SAVE :: INBRESOL=0 +INTEGER(KIND=8) :: ICODEILOEN +INTEGER, SAVE :: INUMMAXRESOLSAVE=-1 +INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: ITRUNCXSAVE, ITRUNCYSAVE, & + IPHYSICALSIZEISAVE, & + IPHYSICALSIZEJSAVE, & + ISIZEISAVE, ISIZEJSAVE, & + IIDENTRESOLSAVE +INTEGER(KIND=8), DIMENSION(:), ALLOCATABLE, SAVE :: ILOENSAVE +REAL(KIND=8), DIMENSION(:), ALLOCATABLE, SAVE :: ZDELTAXSAVE, & + ZDELTAYSAVE +REAL(KIND=8) :: ZEXWN, ZEYWN + +#include "setup_trans0.h" +#include "esetup_trans.h" +#include "setup_trans.h" + +KRETURNCODE=0 +LDSTOP=.FALSE. +! III. Setup + +! III.a Setup LAM and global spectral transform - all resolutions +! Maximum number of resolution is set now and cannot be change anymore +IF (LLFIRSTCALL) THEN + !This code is called only once, whatever is the number of resolutions + CALL SETUP_TRANS0(KPRINTLEV=0, LDMPOFF=.TRUE., KMAX_RESOL=KNUMMAXRESOL) + ALLOCATE(ITRUNCXSAVE(KNUMMAXRESOL)) + ALLOCATE(ITRUNCYSAVE(KNUMMAXRESOL)) + ALLOCATE(IPHYSICALSIZEISAVE(KNUMMAXRESOL)) + ALLOCATE(IPHYSICALSIZEJSAVE(KNUMMAXRESOL)) + ALLOCATE(ISIZEJSAVE(KNUMMAXRESOL)) + ALLOCATE(ISIZEISAVE(KNUMMAXRESOL)) + ALLOCATE(ILOENSAVE(KNUMMAXRESOL)) + ALLOCATE(IIDENTRESOLSAVE(KNUMMAXRESOL)) + ALLOCATE(ZDELTAXSAVE(KNUMMAXRESOL)) + ALLOCATE(ZDELTAYSAVE(KNUMMAXRESOL)) + ITRUNCXSAVE=-1 + ITRUNCYSAVE=-1 + IPHYSICALSIZEISAVE=-1 + IPHYSICALSIZEJSAVE=-1 + ISIZEJSAVE=-1 + ISIZEISAVE=-1 + ILOENSAVE=-1 + IIDENTRESOLSAVE=-1 + ZDELTAXSAVE=-1. + ZDELTAXSAVE=-1. + LLFIRSTCALL=.FALSE. + INUMMAXRESOLSAVE=KNUMMAXRESOL +ENDIF +! +! III.b Is-it a new resolution? +LLNEWRESOL=.TRUE. +IF(LDLAM) THEN + ILOEN(:)=KSIZEI +ELSE + ILOEN(:)=0 + ILOEN(1:MIN(SIZE(ILOEN),SIZE(KLOEN)))=KLOEN(1:MIN(SIZE(ILOEN),SIZE(KLOEN))) +ENDIF +ICODEILOEN=0 +DO JI=1, SIZE(ILOEN) + ICODEILOEN=ICODEILOEN+ILOEN(JI)*JI**4 +ENDDO +DO JI=1, INBRESOL + IF (KTRUNCX==ITRUNCXSAVE(JI) .AND. KTRUNCY==ITRUNCYSAVE(JI) .AND. & + &KPHYSICALSIZEI==IPHYSICALSIZEISAVE(JI) .AND. & + &KPHYSICALSIZEJ==IPHYSICALSIZEJSAVE(JI) .AND. & + &KSIZEJ==ISIZEJSAVE(JI) .AND. KSIZEI==ISIZEISAVE(JI) .AND. & + &ICODEILOEN==ILOENSAVE(JI) .AND. & + &PDELTAX==ZDELTAXSAVE(JI) .AND. PDELTAY==ZDELTAYSAVE(JI)) THEN + KIDENTRESOL=IIDENTRESOLSAVE(JI) + LLNEWRESOL=.FALSE. + ENDIF +ENDDO +IF(LLNEWRESOL) THEN + INBRESOL=INBRESOL+1 + IF(INBRESOL>INUMMAXRESOLSAVE) THEN + PRINT*, "Error in SPEC_SETUP4PY : Maximum number of resolution is exceeded." + KRETURNCODE=-999 + LDSTOP=.TRUE. + ENDIF +ENDIF +! +! III.c Setup LAM or global spectral transform - once by resolution +IF(LLNEWRESOL .AND. .NOT. LDSTOP) THEN + ! The following code is exectuded once for each resolution + ITRUNCXSAVE(INBRESOL)=KTRUNCX + ITRUNCYSAVE(INBRESOL)=KTRUNCY + IPHYSICALSIZEISAVE(INBRESOL)=KPHYSICALSIZEI + IPHYSICALSIZEJSAVE(INBRESOL)=KPHYSICALSIZEJ + ISIZEISAVE(INBRESOL)=KSIZEI + ISIZEJSAVE(INBRESOL)=KSIZEJ + ILOENSAVE(INBRESOL)=ICODEILOEN + ZDELTAXSAVE(INBRESOL)=PDELTAX + ZDELTAYSAVE(INBRESOL)=PDELTAY + IF(LDLAM) THEN + ZEXWN=2*3.141592653589797/(KSIZEI*PDELTAX) + ZEYWN=2*3.141592653589797/(KSIZEJ*PDELTAY) + CALL ESETUP_TRANS(KMSMAX=ITRUNCXSAVE(INBRESOL), KSMAX=ITRUNCYSAVE(INBRESOL), & + &KDGUX=IPHYSICALSIZEJSAVE(INBRESOL), & + &KDGL=ISIZEJSAVE(INBRESOL), KLOEN=ILOEN(:), KRESOL=IIDENTRESOLSAVE(INBRESOL), & + &PEXWN=REAL(ZEXWN,KIND=JPRB), PEYWN=REAL(ZEYWN,KIND=JPRB)) + ELSE + PRINT*, "Setup spectral transform" + CALL SETUP_TRANS(KSMAX=ITRUNCXSAVE(INBRESOL), KDGL=ISIZEJSAVE(INBRESOL), & + &KLOEN=ILOEN(1:ISIZEJSAVE(INBRESOL)), KRESOL=IIDENTRESOLSAVE(INBRESOL)) + PRINT*, "End Setup spectral transform" + ENDIF + KIDENTRESOL=IIDENTRESOLSAVE(INBRESOL) +ENDIF +END SUBROUTINE SPEC_SETUP4PY + diff --git a/src/ectrans4py/trans_inq4py.F90 b/src/ectrans4py/trans_inq4py.F90 new file mode 100644 index 000000000..f989ef175 --- /dev/null +++ b/src/ectrans4py/trans_inq4py.F90 @@ -0,0 +1,70 @@ +SUBROUTINE TRANS_INQ4PY(KRETURNCODE, KSIZEJ, KTRUNC, KSLOEN, KLOEN, KNUMMAXRESOL, & + &KGPTOT, KSPEC, KNMENG) +! ** PURPOSE +! Simplified wrapper to TRANS_INQ +! +! ** DUMMY ARGUMENTS +! KSIZEJ: number of latitudes in grid-point space +! KTRUNC: troncature +! KSLOEN: Size of KLOEN +! KLOEN: number of points on each latitude row +! KNUMMAXRESOL: maximum number of troncatures handled +! KGPTOT: number of gridpoints +! KSPEC: number of spectral coefficients +! KNMENG: cut-off zonal wavenumber +! +! ** AUTHOR +! 9 April 2014, S. Riette +! +! ** MODIFICATIONS +! 6 Jan., S. Riette: w_spec_setup interfaced modified +! +! I. Dummy arguments declaration +IMPLICIT NONE +INTEGER(KIND=8), INTENT(OUT) :: KRETURNCODE +INTEGER(KIND=8), INTENT(IN) :: KSIZEJ +INTEGER(KIND=8), INTENT(IN) :: KTRUNC +INTEGER(KIND=8), INTENT(IN) :: KSLOEN +INTEGER(KIND=8), DIMENSION(KSLOEN), INTENT(IN) :: KLOEN +INTEGER(KIND=8), INTENT(IN) :: KNUMMAXRESOL +INTEGER(KIND=8), INTENT(OUT) :: KGPTOT +INTEGER(KIND=8), INTENT(OUT) :: KSPEC +INTEGER(KIND=8), DIMENSION(KSLOEN), INTENT(OUT) :: KNMENG +! +! II. Local variables declaration +INTEGER, DIMENSION(SIZE(KLOEN)) :: ILOEN +INTEGER :: ISIZEI, ISIZEJ, & + & IPHYSICALSIZEI, IPHYSICALSIZEJ, & + & ITRUNCX, ITRUNCY, & + & INUMMAXRESOL +LOGICAL :: LLSTOP +INTEGER :: IIDENTRESOL +INTEGER :: IGPTOT, ISPEC +INTEGER, DIMENSION(SIZE(KLOEN)) :: INMENG +REAL(KIND=8) :: ZDELTAX, ZDELTAY +#include "trans_inq.h" + +ILOEN(:)=KLOEN(:) +ISIZEI=0 +ISIZEJ=KSIZEJ +IPHYSICALSIZEI=0 +IPHYSICALSIZEJ=0 +ITRUNCX=KTRUNC +ITRUNCY=0 +INUMMAXRESOL=KNUMMAXRESOL +INMENG(:)=KNMENG(:) +! +! III. Setup +ZDELTAX=0. +ZDELTAY=0. +CALL SPEC_SETUP4PY(KRETURNCODE, ISIZEI, ISIZEJ, IPHYSICALSIZEI, IPHYSICALSIZEJ, & + &ITRUNCX, ITRUNCY, INUMMAXRESOL, ILOEN, .FALSE., SIZE(ILOEN), & + &ZDELTAX, ZDELTAY, IIDENTRESOL, LLSTOP) +IF (.NOT. LLSTOP) THEN + CALL TRANS_INQ(KRESOL=IIDENTRESOL, KGPTOT=IGPTOT, KSPEC=ISPEC, KNMENG=INMENG) + KGPTOT=IGPTOT + KSPEC=ISPEC + KNMENG=INMENG +ENDIF +! +END SUBROUTINE TRANS_INQ4PY From c12ef84cad6f459d5d8b056d54313717f3d8df5c Mon Sep 17 00:00:00 2001 From: Alexandre MARY Date: Wed, 30 Oct 2024 09:07:04 +0000 Subject: [PATCH 09/25] ectrans4py version is same as ectrans --- CMakeLists.txt | 1 - setup.py | 18 +++++------------- 2 files changed, 5 insertions(+), 14 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 995cd9e95..9145e25af 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -35,7 +35,6 @@ ecbuild_add_option( FEATURE SINGLE_PRECISION DEFAULT ON DESCRIPTION "Support for Single Precision" ) - if( HAVE_SINGLE_PRECISION ) set( single "single" ) endif() diff --git a/setup.py b/setup.py index 80a8788eb..e164c53ce 100644 --- a/setup.py +++ b/setup.py @@ -1,26 +1,18 @@ import os -import re import ast from skbuild import setup -def get_version(): # remove this part - version_file = os.path.join("src", "ectrans4py", "__init__.py") - with open(version_file, "r", encoding="utf-8") as f: - content = f.read() - version_match = re.search(r"^__version__\s*=\s*['\"]([^'\"]*)['\"]", content, re.M) - if version_match: - return version_match.group(1) - raise RuntimeError("Unable to find version string.") +_version_file = os.path.join(os.path.dirname(os.path.abspath(__file__)), "VERSION") +with open(_version_file, "r") as f: + __version__ = f.read().strip() -version=get_version() -# ectrans4py package : setup( name="ectrans4py", - version=version, + version=__version__, packages=['ectrans4py'], cmake_minimum_required_version="3.13", cmake_args=[ - '-DENABLE_ETRANS=ON', + '-DENABLE_ETRANS=ON', '-DENABLE_ECTRANS4PY=ON', '-DENABLE_SINGLE_PRECISION=OFF', '-DENABLE_OMP=OFF', From 5032eb97861839c3a006e7b533cf3aafa9ba0192 Mon Sep 17 00:00:00 2001 From: Alexandre MARY Date: Wed, 30 Oct 2024 13:51:56 +0100 Subject: [PATCH 10/25] cleaner python package --- pyproject.toml | 7 +++++ src/ectrans4py/__init__.py | 61 ++++++++++++++++---------------------- 2 files changed, 33 insertions(+), 35 deletions(-) diff --git a/pyproject.toml b/pyproject.toml index a003b0c80..6ff8e42ee 100644 --- a/pyproject.toml +++ b/pyproject.toml @@ -2,3 +2,10 @@ requires = ["setuptools", "wheel", "scikit-build"] build-backend = "setuptools.build_meta" +[project] +name = "ectrans4py" +dynamic = ["version"] +dependencies=["numpy", "ctypesForFortran<2.0.0"] + +[tool.setuptools.dynamic] +version = {attr = "ectrans4py.__version__"} diff --git a/src/ectrans4py/__init__.py b/src/ectrans4py/__init__.py index 5591f3465..093f8d2bf 100644 --- a/src/ectrans4py/__init__.py +++ b/src/ectrans4py/__init__.py @@ -1,74 +1,65 @@ #!/usr/bin/env python3 # -*- coding: utf-8 -*- -# Copyright (c) Météo France (2014-) -# This software is governed by the CeCILL-C license under French law. -# http://www.cecill.info """ -ialsptrans4py: +ectrans4py: -Contains the interface to spectral transforms from the IAL/ecTrans. -Note that this is temporary between the former package arpifs4py and a direct python interface to ecTrans. - -Actual .so library should be in one of the preinstalled paths or in a directory specified via LD_LIBRARY_PATH +A Python interface to spectral transforms from ecTrans, using cTypesForFortran for the Fortran/Python binding. """ from __future__ import print_function, absolute_import, unicode_literals, division import os +import resource import numpy as np import ctypesForFortran from ctypesForFortran import addReturnCode, treatReturnCode, IN, OUT +__version__ = "1.2.0" -__version__ = "2.0.1" # Shared objects library ######################## -shared_objects_library = os.environ.get('IALSPTRANS4PY_SO', None) -if shared_objects_library is None or not os.path.exists(shared_objects_library): - # not specified or path does not exist : find in known locations - so_basename = "libtrans_dp.so" # local name in the directory - LD_LIBRARY_PATH = [p for p in os.environ.get('LD_LIBRARY_PATH', '').split(':') if p != ''] - potential_locations = LD_LIBRARY_PATH + [ - os.path.join(os.path.dirname(os.path.realpath(__file__)), 'lib'), # FIXEME : but requiere changes in CMakeLists.txt - os.path.join(os.path.dirname(os.path.realpath(__file__)), 'lib64'), # force one libdir directory name ! -# "/home/common/epygram/public/EPyGrAM/libs4py", # CNRM -# "/home/gmap/mrpe/mary/public/EPyGrAM/libs4py", # belenos/taranis -# "/home/acrd/public/EPyGrAM/libs4py", # ECMWF's Atos aa-ad +so_basename = "libtrans_dp.so" # local name of library in the directory +LD_LIBRARY_PATH = [p for p in os.environ.get('LD_LIBRARY_PATH', '').split(':') if p != ''] +lpath = LD_LIBRARY_PATH + [ + os.path.join(os.path.dirname(os.path.realpath(__file__)), 'lib'), + os.path.join(os.path.dirname(os.path.realpath(__file__)), 'lib64'), ] - for _libs4py_dir in potential_locations: - shared_objects_library = os.path.join(_libs4py_dir, so_basename) - if os.path.exists(shared_objects_library): - break - else: - shared_objects_library = None - if shared_objects_library is None: - msg = ' '.join(["'{}' was not found in any of potential locations: {}.", - "You can specify a different location using env var LD_LIBRARY_PATH", - "or specify a precise full path using env var IALSPTRANS4PY_SO."]).format( - so_filename, str(potential_locations)) - raise FileNotFoundError(msg) -else: - so_basename = os.path.basename(shared_objects_library) +for d in lpath: + shared_objects_library = os.path.join(d, so_basename) + if os.path.exists(shared_objects_library): + break + else: + shared_objects_library = None +if shared_objects_library is None: + msg = ' '.join(["'{}' was not found in any of potential locations: {}.", + "You can specify a different location using env var LD_LIBRARY_PATH"]) + msg = msg.format(so_basename, str(lpath)) + raise FileNotFoundError(msg) ctypesFF, handle = ctypesForFortran.ctypesForFortranFactory(shared_objects_library) # Initialization ################ def init_env(omp_num_threads=None, - no_mpi=False): + no_mpi=True, + unlimited_stack=True, + ): """ Set adequate environment for the inner libraries. :param int omp_num_threads: sets OMP_NUM_THREADS :param bool no_mpi: environment variable DR_HOOK_NOT_MPI set to 1 + :param unlimited_stack: equivalent to 'ulimit -s unlimited' """ # because arpifs library is compiled with MPI & openMP if omp_num_threads is not None: os.environ['OMP_NUM_THREADS'] = str(omp_num_threads) if no_mpi: os.environ['DR_HOOK_NOT_MPI'] = '1' + if unlimited_stack: + resource.setrlimit(resource.RLIMIT_STACK, (resource.RLIM_INFINITY, resource.RLIM_INFINITY)) # Transforms interfaces ####################### From ae6d7e08874052af97497842536eb4fd79e58849 Mon Sep 17 00:00:00 2001 From: Alexandre MARY Date: Wed, 30 Oct 2024 13:52:29 +0100 Subject: [PATCH 11/25] Optional PROGRAMS feature --- CMakeLists.txt | 5 ++++- setup.py | 1 + src/CMakeLists.txt | 4 +++- 3 files changed, 8 insertions(+), 2 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 9145e25af..8921e5543 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -64,7 +64,10 @@ ecbuild_add_option( FEATURE ETRANS DEFAULT OFF DESCRIPTION "Include Limited-Area-Model Transforms" ) - +ecbuild_add_option( FEATURE PROGRAMS + DEFAULT ON + DESCRIPTION "Build src/programs" ) + ecbuild_add_option( FEATURE ECTRANS4PY DEFAULT OFF CONDITION HAVE_ETRANS diff --git a/setup.py b/setup.py index e164c53ce..3fc19a53e 100644 --- a/setup.py +++ b/setup.py @@ -15,6 +15,7 @@ '-DENABLE_ETRANS=ON', '-DENABLE_ECTRANS4PY=ON', '-DENABLE_SINGLE_PRECISION=OFF', + '-DENABLE_PROGRAMS=OFF', '-DENABLE_OMP=OFF', ], package_dir={"": "src"}, diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 706806cd8..963d00090 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -7,7 +7,9 @@ # nor does it submit to any jurisdiction. add_subdirectory( trans ) -add_subdirectory( programs ) +if(HAVE_PROGRAMS) + add_subdirectory( programs ) +endif() if( HAVE_TRANSI ) add_subdirectory(transi) endif() From 6a8de09b80ae078cf5cf4de68a7e2f226302e01c Mon Sep 17 00:00:00 2001 From: Alexandre MARY Date: Wed, 30 Oct 2024 17:58:22 +0100 Subject: [PATCH 12/25] Label 1.2.50 = 1.2.0+@CY50 --- VERSION | 2 +- src/ectrans4py/__init__.py | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/VERSION b/VERSION index 26aaba0e8..99188f0c6 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -1.2.0 +1.2.50 diff --git a/src/ectrans4py/__init__.py b/src/ectrans4py/__init__.py index 093f8d2bf..e28b7acf8 100644 --- a/src/ectrans4py/__init__.py +++ b/src/ectrans4py/__init__.py @@ -15,7 +15,7 @@ from ctypesForFortran import addReturnCode, treatReturnCode, IN, OUT -__version__ = "1.2.0" +__version__ = "1.2.50" # Shared objects library From f01ecf96cd2cf28f050117d2836fefb7199b8ea2 Mon Sep 17 00:00:00 2001 From: Daan Degrauwe Date: Tue, 3 Dec 2024 13:07:02 +0000 Subject: [PATCH 13/25] fixed ETRANS=ON: (i) follow single/double precision mechanism from trans/cpu/; (ii) create separate ectrans_etrans_* libraries instead of patching ectrans_* libraries; (iii) re-introduced FFT992, but put it under a switch WITH_FFT992 everywhere; compiling/running with FFT992 instead of FFTW is probably still broken; (iv) temporarily added ellips.F90, which in fact should go into fiat. --- src/etrans/CMakeLists.txt | 119 + src/etrans/cpu/CMakeLists.txt | 99 + .../{ => cpu}/biper/external/etibihie.F90 | 0 .../{ => cpu}/biper/external/fpbipere.F90 | 0 .../{ => cpu}/biper/external/horiz_field.F90 | 0 .../{ => cpu}/biper/internal/esmoothe_mod.F90 | 0 .../{ => cpu}/biper/internal/espline_mod.F90 | 0 .../{ => cpu}/biper/internal/ewindowe_mod.F90 | 0 .../{ => cpu}/biper/internal/extper_mod.F90 | 0 .../{etrans => cpu}/external/edir_trans.F90 | 0 .../{etrans => cpu}/external/edir_transad.F90 | 0 .../{etrans => cpu}/external/edist_grid.F90 | 0 .../{etrans => cpu}/external/edist_spec.F90 | 0 .../{etrans => cpu}/external/egath_grid.F90 | 0 .../{etrans => cpu}/external/egath_spec.F90 | 0 .../external/egpnorm_trans.F90 | 2 +- .../{etrans => cpu}/external/einv_trans.F90 | 0 .../{etrans => cpu}/external/einv_transad.F90 | 0 .../{etrans => cpu}/external/esetup_trans.F90 | 27 +- .../{etrans => cpu}/external/especnorm.F90 | 0 .../{etrans => cpu}/external/etrans_end.F90 | 16 +- .../{etrans => cpu}/external/etrans_inq.F90 | 0 .../external/etrans_release.F90 | 0 .../{etrans => cpu}/internal/cpl_int_mod.F90 | 0 .../{etrans => cpu}/internal/easre1ad_mod.F90 | 0 .../{etrans => cpu}/internal/easre1b_mod.F90 | 0 .../internal/easre1bad_mod.F90 | 0 .../internal/edealloc_resol_mod.F90 | 12 +- .../internal/edir_trans_ctl_mod.F90 | 0 .../internal/edir_trans_ctlad_mod.F90 | 0 .../internal/edist_spec_control_mod.F90 | 0 .../{etrans => cpu}/internal/efsc_mod.F90 | 0 .../{etrans => cpu}/internal/efscad_mod.F90 | 0 .../internal/eftdir_ctl_mod.F90 | 0 .../internal/eftdir_ctlad_mod.F90 | 0 .../{etrans => cpu}/internal/eftdirad_mod.F90 | 28 +- .../internal/eftinv_ctl_mod.F90 | 0 .../internal/eftinv_ctlad_mod.F90 | 0 .../{etrans => cpu}/internal/eftinvad_mod.F90 | 33 +- .../internal/egath_spec_control_mod.F90 | 0 .../internal/einv_trans_ctl_mod.F90 | 0 .../internal/einv_trans_ctlad_mod.F90 | 0 .../{etrans => cpu}/internal/eledir_mod.F90 | 13 +- .../{etrans => cpu}/internal/eledirad_mod.F90 | 14 +- .../{etrans => cpu}/internal/eleinv_mod.F90 | 14 +- .../{etrans => cpu}/internal/eleinvad_mod.F90 | 15 +- src/etrans/cpu/internal/ellips.F90 | 89 + .../internal/eltdir_ctl_mod.F90 | 0 .../internal/eltdir_ctlad_mod.F90 | 0 .../{etrans => cpu}/internal/eltdir_mod.F90 | 0 .../{etrans => cpu}/internal/eltdirad_mod.F90 | 0 .../internal/eltinv_ctl_mod.F90 | 0 .../internal/eltinv_ctlad_mod.F90 | 0 .../{etrans => cpu}/internal/eltinv_mod.F90 | 0 .../{etrans => cpu}/internal/eltinvad_mod.F90 | 0 .../{etrans => cpu}/internal/eprfi1_mod.F90 | 0 .../{etrans => cpu}/internal/eprfi1ad_mod.F90 | 0 .../{etrans => cpu}/internal/eprfi1b_mod.F90 | 0 .../internal/eprfi1bad_mod.F90 | 0 .../{etrans => cpu}/internal/eprfi2_mod.F90 | 0 .../{etrans => cpu}/internal/eprfi2ad_mod.F90 | 0 .../{etrans => cpu}/internal/eprfi2b_mod.F90 | 0 .../internal/eprfi2bad_mod.F90 | 0 .../internal/eset_resol_mod.F90 | 15 +- .../internal/esetup_dims_mod.F90 | 0 .../internal/esetup_geom_mod.F90 | 0 .../internal/espnorm_ctl_mod.F90 | 0 .../{etrans => cpu}/internal/espnormc_mod.F90 | 0 .../{etrans => cpu}/internal/espnormd_mod.F90 | 0 .../{etrans => cpu}/internal/espnsde_mod.F90 | 0 .../internal/espnsdead_mod.F90 | 0 .../{etrans => cpu}/internal/eupdsp_mod.F90 | 0 .../{etrans => cpu}/internal/eupdspad_mod.F90 | 0 .../{etrans => cpu}/internal/eupdspb_mod.F90 | 0 .../internal/eupdspbad_mod.F90 | 0 .../internal/euvtvd_comm_mod.F90 | 0 .../{etrans => cpu}/internal/euvtvd_mod.F90 | 0 .../{etrans => cpu}/internal/euvtvdad_mod.F90 | 0 .../{etrans => cpu}/internal/evdtuv_mod.F90 | 0 .../internal/evdtuvad_comm_mod.F90 | 0 .../{etrans => cpu}/internal/evdtuvad_mod.F90 | 0 src/etrans/cpu/internal/fft992.F90 | 2377 +++++++++++++++++ src/etrans/cpu/internal/set99.F90 | 82 + src/etrans/cpu/internal/set99b.F90 | 81 + .../{etrans => cpu}/internal/suefft_mod.F90 | 54 +- .../internal/suemp_trans_mod.F90 | 6 +- .../internal/suemp_trans_preleg_mod.F90 | 0 .../{etrans => cpu}/internal/suemplat_mod.F90 | 8 +- .../internal/suemplatb_mod.F90 | 6 +- .../internal/suestaonl_mod.F90 | 6 +- src/etrans/cpu/internal/tpm_fft.F90 | 30 + .../{etrans => cpu}/internal/tpmald_dim.F90 | 0 .../{etrans => cpu}/internal/tpmald_distr.F90 | 0 .../{etrans => cpu}/internal/tpmald_fft.F90 | 2 +- .../internal/tpmald_fields.F90 | 0 .../{etrans => cpu}/internal/tpmald_geo.F90 | 0 .../{etrans => cpu}/internal/tpmald_tcdis.F90 | 0 .../include => include/etrans}/edir_trans.h | 0 .../include => include/etrans}/edir_transad.h | 0 .../include => include/etrans}/edist_grid.h | 0 .../include => include/etrans}/edist_spec.h | 0 .../include => include/etrans}/egath_grid.h | 0 .../include => include/etrans}/egath_spec.h | 0 .../etrans}/egpnorm_trans.h | 0 .../include => include/etrans}/einv_trans.h | 0 .../include => include/etrans}/einv_transad.h | 0 .../include => include/etrans}/esetup_trans.h | 0 .../include => include/etrans}/especnorm.h | 0 .../include => include/etrans}/etibihie.h | 0 .../include => include/etrans}/etrans_end.h | 0 .../include => include/etrans}/etrans_inq.h | 0 .../etrans}/etrans_release.h | 0 .../include => include/etrans}/fpbipere.h | 0 .../include => include/etrans}/horiz_field.h | 0 src/etrans/sedrenames.txt | 149 ++ src/programs/CMakeLists.txt | 2 + 116 files changed, 3140 insertions(+), 159 deletions(-) create mode 100644 src/etrans/cpu/CMakeLists.txt rename src/etrans/{ => cpu}/biper/external/etibihie.F90 (100%) rename src/etrans/{ => cpu}/biper/external/fpbipere.F90 (100%) rename src/etrans/{ => cpu}/biper/external/horiz_field.F90 (100%) rename src/etrans/{ => cpu}/biper/internal/esmoothe_mod.F90 (100%) rename src/etrans/{ => cpu}/biper/internal/espline_mod.F90 (100%) rename src/etrans/{ => cpu}/biper/internal/ewindowe_mod.F90 (100%) rename src/etrans/{ => cpu}/biper/internal/extper_mod.F90 (100%) rename src/etrans/{etrans => cpu}/external/edir_trans.F90 (100%) rename src/etrans/{etrans => cpu}/external/edir_transad.F90 (100%) rename src/etrans/{etrans => cpu}/external/edist_grid.F90 (100%) rename src/etrans/{etrans => cpu}/external/edist_spec.F90 (100%) rename src/etrans/{etrans => cpu}/external/egath_grid.F90 (100%) rename src/etrans/{etrans => cpu}/external/egath_spec.F90 (100%) rename src/etrans/{etrans => cpu}/external/egpnorm_trans.F90 (98%) rename src/etrans/{etrans => cpu}/external/einv_trans.F90 (100%) rename src/etrans/{etrans => cpu}/external/einv_transad.F90 (100%) rename src/etrans/{etrans => cpu}/external/esetup_trans.F90 (97%) rename src/etrans/{etrans => cpu}/external/especnorm.F90 (100%) rename src/etrans/{etrans => cpu}/external/etrans_end.F90 (95%) rename src/etrans/{etrans => cpu}/external/etrans_inq.F90 (100%) rename src/etrans/{etrans => cpu}/external/etrans_release.F90 (100%) rename src/etrans/{etrans => cpu}/internal/cpl_int_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/easre1ad_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/easre1b_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/easre1bad_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/edealloc_resol_mod.F90 (95%) rename src/etrans/{etrans => cpu}/internal/edir_trans_ctl_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/edir_trans_ctlad_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/edist_spec_control_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/efsc_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/efscad_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/eftdir_ctl_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/eftdir_ctlad_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/eftdirad_mod.F90 (86%) rename src/etrans/{etrans => cpu}/internal/eftinv_ctl_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/eftinv_ctlad_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/eftinvad_mod.F90 (82%) rename src/etrans/{etrans => cpu}/internal/egath_spec_control_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/einv_trans_ctl_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/einv_trans_ctlad_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/eledir_mod.F90 (95%) rename src/etrans/{etrans => cpu}/internal/eledirad_mod.F90 (96%) rename src/etrans/{etrans => cpu}/internal/eleinv_mod.F90 (95%) rename src/etrans/{etrans => cpu}/internal/eleinvad_mod.F90 (95%) create mode 100644 src/etrans/cpu/internal/ellips.F90 rename src/etrans/{etrans => cpu}/internal/eltdir_ctl_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/eltdir_ctlad_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/eltdir_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/eltdirad_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/eltinv_ctl_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/eltinv_ctlad_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/eltinv_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/eltinvad_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/eprfi1_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/eprfi1ad_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/eprfi1b_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/eprfi1bad_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/eprfi2_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/eprfi2ad_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/eprfi2b_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/eprfi2bad_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/eset_resol_mod.F90 (93%) rename src/etrans/{etrans => cpu}/internal/esetup_dims_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/esetup_geom_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/espnorm_ctl_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/espnormc_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/espnormd_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/espnsde_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/espnsdead_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/eupdsp_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/eupdspad_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/eupdspb_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/eupdspbad_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/euvtvd_comm_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/euvtvd_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/euvtvdad_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/evdtuv_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/evdtuvad_comm_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/evdtuvad_mod.F90 (100%) create mode 100644 src/etrans/cpu/internal/fft992.F90 create mode 100644 src/etrans/cpu/internal/set99.F90 create mode 100644 src/etrans/cpu/internal/set99b.F90 rename src/etrans/{etrans => cpu}/internal/suefft_mod.F90 (75%) rename src/etrans/{etrans => cpu}/internal/suemp_trans_mod.F90 (98%) rename src/etrans/{etrans => cpu}/internal/suemp_trans_preleg_mod.F90 (100%) rename src/etrans/{etrans => cpu}/internal/suemplat_mod.F90 (98%) rename src/etrans/{etrans => cpu}/internal/suemplatb_mod.F90 (98%) rename src/etrans/{etrans => cpu}/internal/suestaonl_mod.F90 (99%) create mode 100644 src/etrans/cpu/internal/tpm_fft.F90 rename src/etrans/{etrans => cpu}/internal/tpmald_dim.F90 (100%) rename src/etrans/{etrans => cpu}/internal/tpmald_distr.F90 (100%) rename src/etrans/{etrans => cpu}/internal/tpmald_fft.F90 (90%) rename src/etrans/{etrans => cpu}/internal/tpmald_fields.F90 (100%) rename src/etrans/{etrans => cpu}/internal/tpmald_geo.F90 (100%) rename src/etrans/{etrans => cpu}/internal/tpmald_tcdis.F90 (100%) rename src/etrans/{etrans/include => include/etrans}/edir_trans.h (100%) rename src/etrans/{etrans/include => include/etrans}/edir_transad.h (100%) rename src/etrans/{etrans/include => include/etrans}/edist_grid.h (100%) rename src/etrans/{etrans/include => include/etrans}/edist_spec.h (100%) rename src/etrans/{etrans/include => include/etrans}/egath_grid.h (100%) rename src/etrans/{etrans/include => include/etrans}/egath_spec.h (100%) rename src/etrans/{etrans/include => include/etrans}/egpnorm_trans.h (100%) rename src/etrans/{etrans/include => include/etrans}/einv_trans.h (100%) rename src/etrans/{etrans/include => include/etrans}/einv_transad.h (100%) rename src/etrans/{etrans/include => include/etrans}/esetup_trans.h (100%) rename src/etrans/{etrans/include => include/etrans}/especnorm.h (100%) rename src/etrans/{biper/include => include/etrans}/etibihie.h (100%) rename src/etrans/{etrans/include => include/etrans}/etrans_end.h (100%) rename src/etrans/{etrans/include => include/etrans}/etrans_inq.h (100%) rename src/etrans/{etrans/include => include/etrans}/etrans_release.h (100%) rename src/etrans/{biper/include => include/etrans}/fpbipere.h (100%) rename src/etrans/{biper/include => include/etrans}/horiz_field.h (100%) create mode 100644 src/etrans/sedrenames.txt diff --git a/src/etrans/CMakeLists.txt b/src/etrans/CMakeLists.txt index bb6d3c2c5..8f88adc6d 100644 --- a/src/etrans/CMakeLists.txt +++ b/src/etrans/CMakeLists.txt @@ -1,3 +1,120 @@ + + +# (C) Copyright 2020- ECMWF. +# +# This software is licensed under the terms of the Apache Licence Version 2.0 +# which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +# In applying this licence, ECMWF does not waive the privileges and immunities +# granted to it by virtue of its status as an intergovernmental organisation +# nor does it submit to any jurisdiction. + +function(generate_file) + set (options) + set (oneValueArgs INPUT OUTPUT BACKEND) + set (multiValueArgs) + cmake_parse_arguments(_PAR "${options}" "${oneValueArgs}" "${multiValueArgs}" ${ARGN}) + + set(output ${_PAR_OUTPUT}) + set(input ${_PAR_INPUT}) + set(backend ${_PAR_BACKEND}) + set(sed_rules ${PROJECT_SOURCE_DIR}/src/etrans/sedrenames.txt) + + set( JPRB_dp JPRD ) + set( jprb_dp jprd ) + set( JPRB_sp JPRM ) + set( jprb_sp jprm ) + set( JPRB_gpu_dp JPRD ) + set( jprb_gpu_dp jprd ) + set( JPRB_gpu_sp JPRM ) + set( jprb_gpu_sp jprm ) + + add_custom_command( + OUTPUT ${output} + COMMAND cat ${sed_rules} | + sed -e "s/VARIANTDESIGNATOR/${backend}/g" | + sed -e "s/TYPEDESIGNATOR_UPPER/${JPRB_${backend}}/g" | + sed -e "s/TYPEDESIGNATOR_LOWER/${jprb_${backend}}/g" | + sed -rf - ${input} > ${output} + DEPENDS ${input} ${sed_rules} + COMMENT "Generating ${output}" + VERBATIM + ) +endfunction(generate_file) + + +function(generate_backend_includes) + set (options) + set (oneValueArgs BACKEND TARGET DESTINATION INCLUDE_DIRECTORY) + set (multiValueArgs) + cmake_parse_arguments(_PAR "${options}" "${oneValueArgs}" "${multiValueArgs}" ${ARGN}) + + set(destination ${_PAR_DESTINATION} ) + set(backend ${_PAR_BACKEND}) + + file(MAKE_DIRECTORY ${destination}) + file(MAKE_DIRECTORY ${destination}/etrans_${backend}) + + ecbuild_list_add_pattern( LIST absolute_files GLOB etrans/*.h SOURCE_DIR ${_PAR_INCLUDE_DIRECTORY} QUIET ) + set( files ) + foreach(file_i ${absolute_files}) + file(RELATIVE_PATH file_i ${_PAR_INCLUDE_DIRECTORY} ${file_i}) + list(APPEND files ${file_i}) + endforeach() + set( outfiles ) + foreach(file_i ${files}) + get_filename_component(outfile_name ${file_i} NAME) + get_filename_component(outfile_name_we ${file_i} NAME_WE) + get_filename_component(outfile_ext ${file_i} EXT) + get_filename_component(outfile_dir ${file_i} DIRECTORY) + if (${file_i} IN_LIST ectrans_common_includes) + configure_file(${_PAR_INCLUDE_DIRECTORY}/${file_i} ${destination}/${outfile_name}) + else() + set(outfile "${destination}/${outfile_name_we}_${backend}${outfile_ext}") + ecbuild_debug("Generate ${outfile}") + generate_file(BACKEND ${backend} INPUT ${_PAR_INCLUDE_DIRECTORY}/${file_i} OUTPUT ${outfile}) + list(APPEND outfiles ${outfile}) + string(TOUPPER ${outfile_name_we} OUTFILE_NAME_WE ) + ecbuild_debug("Generate ${destination}/trans_${backend}/${outfile_name}") + file(WRITE ${destination}/trans_${backend}/${outfile_name} "! Automatically generated interface header for backward compatibility of generic symbols !\n") + file(APPEND ${destination}/trans_${backend}/${outfile_name} "#if defined(${outfile_name_we})\n") + file(APPEND ${destination}/trans_${backend}/${outfile_name} "#undef ${outfile_name_we}\n") + file(APPEND ${destination}/trans_${backend}/${outfile_name} "#endif\n") + file(APPEND ${destination}/trans_${backend}/${outfile_name} "#if defined(${OUTFILE_NAME_WE})\n") + file(APPEND ${destination}/trans_${backend}/${outfile_name} "#undef ${OUTFILE_NAME_WE}\n") + file(APPEND ${destination}/trans_${backend}/${outfile_name} "#endif\n") + file(APPEND ${destination}/trans_${backend}/${outfile_name} "#include \"${outfile_name_we}_${backend}${outfile_ext}\"\n") + file(APPEND ${destination}/trans_${backend}/${outfile_name} "#define ${outfile_name_we} ${OUTFILE_NAME_WE}_${backend}\n") + file(APPEND ${destination}/trans_${backend}/${outfile_name} "#define ${OUTFILE_NAME_WE} ${OUTFILE_NAME_WE}_${backend}\n") + endif() + endforeach(file_i) + + add_custom_target(${_PAR_TARGET}_generate DEPENDS ${outfiles}) + ecbuild_add_library(TARGET ${_PAR_TARGET} TYPE INTERFACE) + add_dependencies(${_PAR_TARGET} ${_PAR_TARGET}_generate) + target_include_directories(${_PAR_TARGET} INTERFACE $) +endfunction(generate_backend_includes) + + + + + +# TODO: move precision-independent files to common +#add_subdirectory( common ) + +if( HAVE_CPU) + add_subdirectory( cpu ) +endif() + +# placeholder +#if( HAVE_GPU ) +# add_subdirectory( gpu ) +#endif() + + +if (FALSE) +# original cmake file for etrans; keeping it for reference, but should be cleaned later +message(FATAL_ERROR "Hold it right there!") + # build list of sources to add to trans library # (using CMAKE_CURRENT_SOURCE_DIR is necessary because sources are in a different directory than the target library (trans_${prec}) ecbuild_list_add_pattern( LIST etrans_src @@ -33,3 +150,5 @@ install( FILES ${etrans_interface} DESTINATION include/ectrans ) + +endif() \ No newline at end of file diff --git a/src/etrans/cpu/CMakeLists.txt b/src/etrans/cpu/CMakeLists.txt new file mode 100644 index 000000000..85ef861ee --- /dev/null +++ b/src/etrans/cpu/CMakeLists.txt @@ -0,0 +1,99 @@ +# (C) Copyright 2020- ECMWF. +# +# This software is licensed under the terms of the Apache Licence Version 2.0 +# which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +# In applying this licence, ECMWF does not waive the privileges and immunities +# granted to it by virtue of its status as an intergovernmental organisation +# nor does it submit to any jurisdiction. + +## Apply workarounds for some known compilers +## see trans/ for example + +function(generate_backend_sources) + set (options) + set (oneValueArgs BACKEND DESTINATION OUTPUT) + set (multiValueArgs) + + cmake_parse_arguments(_PAR "${options}" "${oneValueArgs}" "${multiValueArgs}" ${ARGN}) + set(backend ${_PAR_BACKEND}) + set(destination ${_PAR_DESTINATION}) + file(MAKE_DIRECTORY ${destination}/biper/internal) + file(MAKE_DIRECTORY ${destination}/biper/external) + file(MAKE_DIRECTORY ${destination}/internal) + file(MAKE_DIRECTORY ${destination}/external) + + ecbuild_list_add_pattern( LIST files + GLOB + internal/*.F90 + external/*.F90 + biper/internal/*.F90 + biper/external/*.F90 + QUIET + ) + + set(outfiles) + foreach(file_i ${files}) + get_filename_component(outfile_name ${file_i} NAME) + get_filename_component(outfile_name_we ${file_i} NAME_WE) + get_filename_component(outfile_ext ${file_i} EXT) + get_filename_component(outfile_dir ${file_i} DIRECTORY) + set(outfile "${destination}/${file_i}") + ecbuild_debug("Generate ${outfile}") + generate_file(BACKEND ${backend} INPUT ${CMAKE_CURRENT_SOURCE_DIR}/${file_i} OUTPUT ${outfile}) + list(APPEND outfiles ${outfile}) + endforeach(file_i) + set(${_PAR_OUTPUT} ${outfiles} PARENT_SCOPE) +endfunction(generate_backend_sources) + +set( BUILD_INTERFACE_INCLUDE_DIR ${CMAKE_BINARY_DIR}/include/ectrans ) + +foreach( prec dp sp ) + if( HAVE_${prec} ) + + generate_backend_includes(BACKEND ${prec} TARGET ectrans_etrans_${prec}_includes DESTINATION ${BUILD_INTERFACE_INCLUDE_DIR} INCLUDE_DIRECTORY ${PROJECT_SOURCE_DIR}/src/etrans/include ) + generate_backend_sources( BACKEND ${prec} OUTPUT ectrans_etrans_${prec}_src DESTINATION ${CMAKE_CURRENT_BINARY_DIR}/generated/ectrans_etrans_${prec}) + ecbuild_add_library( + TARGET ectrans_etrans_${prec} + LINKER_LANGUAGE Fortran + SOURCES ${ectrans_etrans_${prec}_src} + PUBLIC_INCLUDES $ + $ + $ + PUBLIC_LIBS fiat ectrans_common ectrans_${prec}_includes ectrans_${prec} ectrans_etrans_${prec}_includes + ) + + ectrans_target_fortran_module_directory( + TARGET ectrans_etrans_${prec} + MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/module/ectrans + INSTALL_DIRECTORY module/ectrans + ) + + set( FFTW_LINK PRIVATE ) + if( LAPACK_LIBRARIES MATCHES "mkl" AND NOT FFTW_LIBRARIES MATCHES "mkl" ) + ecbuild_warn( "Danger: Both MKL and FFTW are linked in trans_${prec}. " + "No guarantees on link order can be made for the final executable.") + set( FFTW_LINK PUBLIC ) # Attempt anyway to give FFTW precedence + endif() + ecbuild_debug("target_link_libraries( trans_${prec} ${FFTW_LINK} ${FFTW_LIBRARIES} )") + target_link_libraries( ectrans_etrans_${prec} ${FFTW_LINK} ${FFTW_LIBRARIES} ) + target_include_directories( ectrans_etrans_${prec} PRIVATE ${FFTW_INCLUDE_DIRS} ) + target_compile_definitions( ectrans_etrans_${prec} PRIVATE WITH_FFTW ) + # daand: lam transforms don't need lapack + #ecbuild_debug("target_link_libraries( ectrans_etrans_${prec} PRIVATE ${LAPACK_LIBRARIES} )") + #target_link_libraries( ectrans_${prec} PRIVATE ${LAPACK_LIBRARIES} ) + + if( HAVE_OMP ) + ecbuild_debug("target_link_libraries( ectrans_${prec} PRIVATE OpenMP::OpenMP_Fortran )") + target_link_libraries( ectrans_${prec} PRIVATE OpenMP::OpenMP_Fortran ) + endif() + + # This interface library is for backward compatibility, and provides the older includes + ecbuild_add_library( TARGET etrans_${prec} TYPE INTERFACE ) + target_include_directories( etrans_${prec} INTERFACE $ ) + target_include_directories( etrans_${prec} INTERFACE $ ) + target_link_libraries( trans_${prec} INTERFACE fiat ectrans_${prec} ectrans_etrans_${prec} parkind_${prec}) + endif() +endforeach() + +## Install trans interface +install( DIRECTORY ${BUILD_INTERFACE_INCLUDE_DIR}/ DESTINATION include/ectrans ) diff --git a/src/etrans/biper/external/etibihie.F90 b/src/etrans/cpu/biper/external/etibihie.F90 similarity index 100% rename from src/etrans/biper/external/etibihie.F90 rename to src/etrans/cpu/biper/external/etibihie.F90 diff --git a/src/etrans/biper/external/fpbipere.F90 b/src/etrans/cpu/biper/external/fpbipere.F90 similarity index 100% rename from src/etrans/biper/external/fpbipere.F90 rename to src/etrans/cpu/biper/external/fpbipere.F90 diff --git a/src/etrans/biper/external/horiz_field.F90 b/src/etrans/cpu/biper/external/horiz_field.F90 similarity index 100% rename from src/etrans/biper/external/horiz_field.F90 rename to src/etrans/cpu/biper/external/horiz_field.F90 diff --git a/src/etrans/biper/internal/esmoothe_mod.F90 b/src/etrans/cpu/biper/internal/esmoothe_mod.F90 similarity index 100% rename from src/etrans/biper/internal/esmoothe_mod.F90 rename to src/etrans/cpu/biper/internal/esmoothe_mod.F90 diff --git a/src/etrans/biper/internal/espline_mod.F90 b/src/etrans/cpu/biper/internal/espline_mod.F90 similarity index 100% rename from src/etrans/biper/internal/espline_mod.F90 rename to src/etrans/cpu/biper/internal/espline_mod.F90 diff --git a/src/etrans/biper/internal/ewindowe_mod.F90 b/src/etrans/cpu/biper/internal/ewindowe_mod.F90 similarity index 100% rename from src/etrans/biper/internal/ewindowe_mod.F90 rename to src/etrans/cpu/biper/internal/ewindowe_mod.F90 diff --git a/src/etrans/biper/internal/extper_mod.F90 b/src/etrans/cpu/biper/internal/extper_mod.F90 similarity index 100% rename from src/etrans/biper/internal/extper_mod.F90 rename to src/etrans/cpu/biper/internal/extper_mod.F90 diff --git a/src/etrans/etrans/external/edir_trans.F90 b/src/etrans/cpu/external/edir_trans.F90 similarity index 100% rename from src/etrans/etrans/external/edir_trans.F90 rename to src/etrans/cpu/external/edir_trans.F90 diff --git a/src/etrans/etrans/external/edir_transad.F90 b/src/etrans/cpu/external/edir_transad.F90 similarity index 100% rename from src/etrans/etrans/external/edir_transad.F90 rename to src/etrans/cpu/external/edir_transad.F90 diff --git a/src/etrans/etrans/external/edist_grid.F90 b/src/etrans/cpu/external/edist_grid.F90 similarity index 100% rename from src/etrans/etrans/external/edist_grid.F90 rename to src/etrans/cpu/external/edist_grid.F90 diff --git a/src/etrans/etrans/external/edist_spec.F90 b/src/etrans/cpu/external/edist_spec.F90 similarity index 100% rename from src/etrans/etrans/external/edist_spec.F90 rename to src/etrans/cpu/external/edist_spec.F90 diff --git a/src/etrans/etrans/external/egath_grid.F90 b/src/etrans/cpu/external/egath_grid.F90 similarity index 100% rename from src/etrans/etrans/external/egath_grid.F90 rename to src/etrans/cpu/external/egath_grid.F90 diff --git a/src/etrans/etrans/external/egath_spec.F90 b/src/etrans/cpu/external/egath_spec.F90 similarity index 100% rename from src/etrans/etrans/external/egath_spec.F90 rename to src/etrans/cpu/external/egath_spec.F90 diff --git a/src/etrans/etrans/external/egpnorm_trans.F90 b/src/etrans/cpu/external/egpnorm_trans.F90 similarity index 98% rename from src/etrans/etrans/external/egpnorm_trans.F90 rename to src/etrans/cpu/external/egpnorm_trans.F90 index 3c2b32906..bbbf462ae 100644 --- a/src/etrans/etrans/external/egpnorm_trans.F90 +++ b/src/etrans/cpu/external/egpnorm_trans.F90 @@ -69,7 +69,7 @@ SUBROUTINE EGPNORM_TRANS(PGP,KFIELDS,KPROMA,PAVE,PMIN,PMAX,LDAVE_ONLY,KRESOL) ! Local variables INTEGER(KIND=JPIM) :: JGL -REAL(KIND=JPRB) :: ZW(R%NDGL) +REAL(KIND=JPRD) :: ZW(R%NDGL) REAL(KIND=JPHOOK) :: ZHOOK_HANDLE ! ------------------------------------------------------------------ diff --git a/src/etrans/etrans/external/einv_trans.F90 b/src/etrans/cpu/external/einv_trans.F90 similarity index 100% rename from src/etrans/etrans/external/einv_trans.F90 rename to src/etrans/cpu/external/einv_trans.F90 diff --git a/src/etrans/etrans/external/einv_transad.F90 b/src/etrans/cpu/external/einv_transad.F90 similarity index 100% rename from src/etrans/etrans/external/einv_transad.F90 rename to src/etrans/cpu/external/einv_transad.F90 diff --git a/src/etrans/etrans/external/esetup_trans.F90 b/src/etrans/cpu/external/esetup_trans.F90 similarity index 97% rename from src/etrans/etrans/external/esetup_trans.F90 rename to src/etrans/cpu/external/esetup_trans.F90 index f01b0a77c..f1bc92378 100644 --- a/src/etrans/etrans/external/esetup_trans.F90 +++ b/src/etrans/cpu/external/esetup_trans.F90 @@ -76,16 +76,16 @@ SUBROUTINE ESETUP_TRANS(KMSMAX,KSMAX,KDGL,KDGUX,KLOEN,LDSPLIT,& USE TPM_DISTR ,ONLY : D, DISTR_RESOL USE TPM_GEOMETRY ,ONLY : G, GEOM_RESOL USE TPM_FIELDS ,ONLY : FIELDS_RESOL -USE TPM_FFT ,ONLY : T, FFT_RESOL, TB, FFTB_RESOL -#ifdef WITH_FFTW -USE TPM_FFTW ,ONLY : TW, FFTW_RESOL +#ifdef WITH_FFT992 +USE TPM_FFT ,ONLY : T, FFT_RESOL +USE TPMALD_FFT ,ONLY : TALD, ALDFFT_RESOL #endif +USE TPM_FFTW ,ONLY : TW, FFTW_RESOL USE TPM_FLT ,ONLY : FLT_RESOL USE TPM_CTL ,ONLY : CTL_RESOL USE TPMALD_DIM ,ONLY : RALD, ALDDIM_RESOL USE TPMALD_DISTR ,ONLY : ALDDISTR_RESOL -USE TPMALD_FFT ,ONLY : TALD, ALDFFT_RESOL USE TPMALD_FIELDS ,ONLY : ALDFIELDS_RESOL USE TPMALD_GEO ,ONLY : GALD, ALDGEO_RESOL @@ -144,11 +144,10 @@ SUBROUTINE ESETUP_TRANS(KMSMAX,KSMAX,KDGL,KDGUX,KLOEN,LDSPLIT,& ALLOCATE(FIELDS_RESOL(NMAX_RESOL)) ALLOCATE(GEOM_RESOL(NMAX_RESOL)) ALLOCATE(DISTR_RESOL(NMAX_RESOL)) +#ifdef WITH_FFT992 ALLOCATE(FFT_RESOL(NMAX_RESOL)) - ALLOCATE(FFTB_RESOL(NMAX_RESOL)) -#ifdef WITH_FFTW - ALLOCATE(FFTW_RESOL(NMAX_RESOL)) #endif + ALLOCATE(FFTW_RESOL(NMAX_RESOL)) ALLOCATE(FLT_RESOL(NMAX_RESOL)) ALLOCATE(CTL_RESOL(NMAX_RESOL)) GEOM_RESOL(:)%LAM=.FALSE. @@ -166,7 +165,9 @@ SUBROUTINE ESETUP_TRANS(KMSMAX,KSMAX,KDGL,KDGUX,KLOEN,LDSPLIT,& ALLOCATE(ALDFIELDS_RESOL(NMAX_RESOL)) ALLOCATE(ALDGEO_RESOL(NMAX_RESOL)) ALLOCATE(ALDDISTR_RESOL(NMAX_RESOL)) +#ifdef WITH_FFT992 ALLOCATE(ALDFFT_RESOL(NMAX_RESOL)) +#endif ENDIF @@ -183,11 +184,10 @@ SUBROUTINE ESETUP_TRANS(KMSMAX,KSMAX,KDGL,KDGUX,KLOEN,LDSPLIT,& G%LREDUCED_GRID = .FALSE. D%LGRIDONLY = .FALSE. D%LSPLIT = .FALSE. +#ifdef WITH_FFT992 TALD%LFFT992=.TRUE. ! Use FFT992 interface for FFTs -#ifdef WITH_FFTW -TW%LFFTW=.FALSE. ! Use FFTW interface for FFTs -TW%LALL_FFTW=.FALSE. ! transform fields one at a time #endif +TW%LALL_FFTW=.FALSE. ! transform fields one at a time ! NON-OPTIONAL ARGUMENTS R%NSMAX = KSMAX @@ -260,20 +260,17 @@ SUBROUTINE ESETUP_TRANS(KMSMAX,KSMAX,KDGL,KDGUX,KLOEN,LDSPLIT,& R%NNOEXTZG=0 ENDIF -#ifdef WITH_FFTW -IF(PRESENT(LDUSEFFTW)) THEN - TW%LFFTW=LDUSEFFTW -ENDIF IF(PRESENT(LD_ALL_FFTW)) THEN TW%LALL_FFTW=LD_ALL_FFTW ENDIF -#endif +#ifdef WITH_FFT992 IF(PRESENT(LDUSEFFTW)) THEN TALD%LFFT992=.NOT.LDUSEFFTW ELSE TALD%LFFT992=.TRUE. ENDIF +#endif ! Setup resolution dependent structures ! ------------------------------------- diff --git a/src/etrans/etrans/external/especnorm.F90 b/src/etrans/cpu/external/especnorm.F90 similarity index 100% rename from src/etrans/etrans/external/especnorm.F90 rename to src/etrans/cpu/external/especnorm.F90 diff --git a/src/etrans/etrans/external/etrans_end.F90 b/src/etrans/cpu/external/etrans_end.F90 similarity index 95% rename from src/etrans/etrans/external/etrans_end.F90 rename to src/etrans/cpu/external/etrans_end.F90 index 18905e499..e93a1845e 100644 --- a/src/etrans/etrans/external/etrans_end.F90 +++ b/src/etrans/cpu/external/etrans_end.F90 @@ -44,15 +44,15 @@ SUBROUTINE ETRANS_END(CDMODE) USE TPM_DISTR ,ONLY : D, DISTR_RESOL, NPRCIDS USE TPM_GEOMETRY ,ONLY : G, GEOM_RESOL USE TPM_FIELDS ,ONLY : F, FIELDS_RESOL -USE TPM_FFT ,ONLY : T, FFT_RESOL, TB, FFTB_RESOL -#ifdef WITH_FFTW -USE TPM_FFTW ,ONLY : TW, FFTW_RESOL +#ifdef WITH_FFT992 +USE TPM_FFT ,ONLY : T, FFT_RESOL +USE TPMALD_FFT ,ONLY : TALD, ALDFFT_RESOL #endif +USE TPM_FFTW ,ONLY : TW, FFTW_RESOL USE TPM_FLT ,ONLY : S, FLT_RESOL USE TPM_TRANS ,ONLY : FOUBUF, FOUBUF_IN USE TPMALD_DIM ,ONLY : RALD, ALDDIM_RESOL USE TPMALD_DISTR ,ONLY : DALD, ALDDISTR_RESOL -USE TPMALD_FFT ,ONLY : TALD, ALDFFT_RESOL USE TPMALD_FIELDS ,ONLY : FALD, ALDFIELDS_RESOL USE TPMALD_GEO ,ONLY : GALD, ALDGEO_RESOL @@ -90,21 +90,21 @@ SUBROUTINE ETRANS_END(CDMODE) IF (ALLOCATED(DISTR_RESOL)) DEALLOCATE(DISTR_RESOL) NULLIFY(DALD) IF (ALLOCATED(ALDDISTR_RESOL)) DEALLOCATE(ALDDISTR_RESOL) +#ifdef WITH_FFT992 !TPM_FFT NULLIFY(T) IF (ALLOCATED(FFT_RESOL)) DEALLOCATE(FFT_RESOL) - NULLIFY(TB) - IF( ALLOCATED(FFTB_RESOL) ) DEALLOCATE(FFTB_RESOL) -#ifdef WITH_FFTW +#endif !TPM_FFTW NULLIFY(TW) DEALLOCATE(FFTW_RESOL) -#endif !TPM_FLT NULLIFY(S) IF (ALLOCATED(FLT_RESOL)) DEALLOCATE(FLT_RESOL) +#ifdef WITH_FFT992 NULLIFY(TALD) IF (ALLOCATED(ALDFFT_RESOL)) DEALLOCATE(ALDFFT_RESOL) +#endif !TPM_FIELDS NULLIFY(F) diff --git a/src/etrans/etrans/external/etrans_inq.F90 b/src/etrans/cpu/external/etrans_inq.F90 similarity index 100% rename from src/etrans/etrans/external/etrans_inq.F90 rename to src/etrans/cpu/external/etrans_inq.F90 diff --git a/src/etrans/etrans/external/etrans_release.F90 b/src/etrans/cpu/external/etrans_release.F90 similarity index 100% rename from src/etrans/etrans/external/etrans_release.F90 rename to src/etrans/cpu/external/etrans_release.F90 diff --git a/src/etrans/etrans/internal/cpl_int_mod.F90 b/src/etrans/cpu/internal/cpl_int_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/cpl_int_mod.F90 rename to src/etrans/cpu/internal/cpl_int_mod.F90 diff --git a/src/etrans/etrans/internal/easre1ad_mod.F90 b/src/etrans/cpu/internal/easre1ad_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/easre1ad_mod.F90 rename to src/etrans/cpu/internal/easre1ad_mod.F90 diff --git a/src/etrans/etrans/internal/easre1b_mod.F90 b/src/etrans/cpu/internal/easre1b_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/easre1b_mod.F90 rename to src/etrans/cpu/internal/easre1b_mod.F90 diff --git a/src/etrans/etrans/internal/easre1bad_mod.F90 b/src/etrans/cpu/internal/easre1bad_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/easre1bad_mod.F90 rename to src/etrans/cpu/internal/easre1bad_mod.F90 diff --git a/src/etrans/etrans/internal/edealloc_resol_mod.F90 b/src/etrans/cpu/internal/edealloc_resol_mod.F90 similarity index 95% rename from src/etrans/etrans/internal/edealloc_resol_mod.F90 rename to src/etrans/cpu/internal/edealloc_resol_mod.F90 index 5d341b92f..0864d97b8 100644 --- a/src/etrans/etrans/internal/edealloc_resol_mod.F90 +++ b/src/etrans/cpu/internal/edealloc_resol_mod.F90 @@ -37,10 +37,10 @@ SUBROUTINE EDEALLOC_RESOL(KRESOL) USE TPM_DISTR ,ONLY : D USE TPM_GEOMETRY ,ONLY : G USE TPM_FIELDS ,ONLY : F +#ifdef WITH_FFT992 USE TPM_FFT ,ONLY : T -#ifdef WITH_FFTW -USE TPM_FFTW ,ONLY : TW,DESTROY_PLANS_FFTW #endif +USE TPM_FFTW ,ONLY : TW,DESTROY_PLANS_FFTW USE TPM_FLT ,ONLY : S USE ESET_RESOL_MOD ,ONLY : ESET_RESOL @@ -75,14 +75,12 @@ SUBROUTINE EDEALLOC_RESOL(KRESOL) DEALLOCATE(D%NPNTGTB1,D%NLTSFTB,D%NLTSGTB,D%MSTABF) DEALLOCATE(D%NSTAGTF) +#ifdef WITH_FFT992 !TPM_FFT DEALLOCATE(T%TRIGS,T%NFAX) -#ifdef WITH_FFTW - !TPM_FFTW - IF( TW%LFFTW )THEN - CALL DESTROY_PLANS_FFTW - ENDIF #endif + !TPM_FFTW + CALL DESTROY_PLANS_FFTW !TPM_GEOMETRY DEALLOCATE(G%NMEN,G%NDGLU) diff --git a/src/etrans/etrans/internal/edir_trans_ctl_mod.F90 b/src/etrans/cpu/internal/edir_trans_ctl_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/edir_trans_ctl_mod.F90 rename to src/etrans/cpu/internal/edir_trans_ctl_mod.F90 diff --git a/src/etrans/etrans/internal/edir_trans_ctlad_mod.F90 b/src/etrans/cpu/internal/edir_trans_ctlad_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/edir_trans_ctlad_mod.F90 rename to src/etrans/cpu/internal/edir_trans_ctlad_mod.F90 diff --git a/src/etrans/etrans/internal/edist_spec_control_mod.F90 b/src/etrans/cpu/internal/edist_spec_control_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/edist_spec_control_mod.F90 rename to src/etrans/cpu/internal/edist_spec_control_mod.F90 diff --git a/src/etrans/etrans/internal/efsc_mod.F90 b/src/etrans/cpu/internal/efsc_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/efsc_mod.F90 rename to src/etrans/cpu/internal/efsc_mod.F90 diff --git a/src/etrans/etrans/internal/efscad_mod.F90 b/src/etrans/cpu/internal/efscad_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/efscad_mod.F90 rename to src/etrans/cpu/internal/efscad_mod.F90 diff --git a/src/etrans/etrans/internal/eftdir_ctl_mod.F90 b/src/etrans/cpu/internal/eftdir_ctl_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/eftdir_ctl_mod.F90 rename to src/etrans/cpu/internal/eftdir_ctl_mod.F90 diff --git a/src/etrans/etrans/internal/eftdir_ctlad_mod.F90 b/src/etrans/cpu/internal/eftdir_ctlad_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/eftdir_ctlad_mod.F90 rename to src/etrans/cpu/internal/eftdir_ctlad_mod.F90 diff --git a/src/etrans/etrans/internal/eftdirad_mod.F90 b/src/etrans/cpu/internal/eftdirad_mod.F90 similarity index 86% rename from src/etrans/etrans/internal/eftdirad_mod.F90 rename to src/etrans/cpu/internal/eftdirad_mod.F90 index 10a7f2259..4790b6b8b 100644 --- a/src/etrans/etrans/internal/eftdirad_mod.F90 +++ b/src/etrans/cpu/internal/eftdirad_mod.F90 @@ -38,11 +38,11 @@ SUBROUTINE EFTDIRAD(PREEL,KFIELDS,KGL) USE TPM_DISTR ,ONLY : D, MYSETW !USE TPM_TRANS USE TPM_GEOMETRY ,ONLY : G -USE TPM_FFT ,ONLY : T, TB -USE BLUESTEIN_MOD ,ONLY : BLUESTEIN_FFT -#ifdef WITH_FFTW -USE TPM_FFTW ,ONLY : TW, EXEC_FFTW +#ifdef WITH_FFT992 +USE TPM_FFT ,ONLY : T +USE TPMALD_FFT , ONLY : TALD #endif +USE TPM_FFTW ,ONLY : TW, EXEC_FFTW USE TPM_DIM ,ONLY : R USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS @@ -78,28 +78,20 @@ SUBROUTINE EFTDIRAD(PREEL,KFIELDS,KGL) ENDDO ENDDO -#ifdef WITH_FFTW -IF( .NOT. TW%LFFTW )THEN -#endif - - IF( T%LUSEFFT992(KGL) )THEN +#ifdef WITH_FFT992 +IF( TALD%LFFT992 )THEN - CALL FFT992(PREEL(1,IOFF),T%TRIGS(1,KGL),& - &T%NFAX(1,KGL),KFIELDS,IJUMP,ILOEN,KFIELDS,ITYPE) + CALL FFT992(PREEL(1,IOFF),T%TRIGS(1,KGL),& + &T%NFAX(1,KGL),KFIELDS,IJUMP,ILOEN,KFIELDS,ITYPE) - ELSE - - CALL BLUESTEIN_FFT(TB,ILOEN,ITYPE,KFIELDS,PREEL(1:KFIELDS,IOFF:IOFF+ICLEN-1)) - - ENDIF - -#ifdef WITH_FFTW ELSE +#endif IRLEN=G%NLOEN(IGLG)+R%NNOEXTZL ICLEN=(IRLEN/2+1)*2 CALL EXEC_FFTW(ITYPE,IRLEN,ICLEN,IOFF,KFIELDS,TW%LALL_FFTW,PREEL) +#ifdef WITH_FFT992 ENDIF #endif diff --git a/src/etrans/etrans/internal/eftinv_ctl_mod.F90 b/src/etrans/cpu/internal/eftinv_ctl_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/eftinv_ctl_mod.F90 rename to src/etrans/cpu/internal/eftinv_ctl_mod.F90 diff --git a/src/etrans/etrans/internal/eftinv_ctlad_mod.F90 b/src/etrans/cpu/internal/eftinv_ctlad_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/eftinv_ctlad_mod.F90 rename to src/etrans/cpu/internal/eftinv_ctlad_mod.F90 diff --git a/src/etrans/etrans/internal/eftinvad_mod.F90 b/src/etrans/cpu/internal/eftinvad_mod.F90 similarity index 82% rename from src/etrans/etrans/internal/eftinvad_mod.F90 rename to src/etrans/cpu/internal/eftinvad_mod.F90 index b1c1df4ff..0c0ebcac6 100644 --- a/src/etrans/etrans/internal/eftinvad_mod.F90 +++ b/src/etrans/cpu/internal/eftinvad_mod.F90 @@ -39,11 +39,11 @@ SUBROUTINE EFTINVAD(PREEL,KFIELDS,KGL) USE TPM_DISTR ,ONLY : D, MYSETW USE TPM_DIM ,ONLY : R USE TPM_GEOMETRY ,ONLY : G -USE TPM_FFT ,ONLY : T, TB -USE BLUESTEIN_MOD ,ONLY : BLUESTEIN_FFT -#ifdef WITH_FFTW -USE TPM_FFTW ,ONLY : TW, EXEC_FFTW +#ifdef WITH_FFT992 +USE TPM_FFT ,ONLY : T +USE TPMALD_FFT, ONLY :: TALD #endif +USE TPM_FFTW ,ONLY : TW, EXEC_FFTW USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS ! @@ -72,33 +72,20 @@ SUBROUTINE EFTINVAD(PREEL,KFIELDS,KGL) ! ! Change of metric (not in forward routine) -#ifdef WITH_FFTW -IF( .NOT. TW%LFFTW )THEN -#endif - - IF( T%LUSEFFT992(KGL) )THEN +#ifdef WITH_FFT992 +IF( TALD%LFFT992 )THEN - CALL FFT992(PREEL(1,IOFF),T%TRIGS(1,KGL),& - &T%NFAX(1,KGL),KFIELDS,IJUMP,ILOEN,KFIELDS,ITYPE) + CALL FFT992(PREEL(1,IOFF),T%TRIGS(1,KGL),& + &T%NFAX(1,KGL),KFIELDS,IJUMP,ILOEN,KFIELDS,ITYPE) - ELSE - - CALL BLUESTEIN_FFT(TB,ILOEN,ITYPE,KFIELDS,PREEL(1:KFIELDS,IOFF:IOFF+ICLEN-1)) - DO JJ=1,ICLEN - DO JF=1,KFIELDS - PREEL(JF,IOFF-1+JJ)=PREEL(JF,IOFF-1+JJ)/REAL(ILOEN,JPRB) - ENDDO - ENDDO - - ENDIF - -#ifdef WITH_FFTW ELSE +#endif IRLEN=G%NLOEN(IGLG)+R%NNOEXTZL ICLEN=(IRLEN/2+1)*2 CALL EXEC_FFTW(ITYPE,IRLEN,ICLEN,IOFF,KFIELDS,TW%LALL_FFTW,PREEL) +#ifdef WITH_FFT992 ENDIF #endif diff --git a/src/etrans/etrans/internal/egath_spec_control_mod.F90 b/src/etrans/cpu/internal/egath_spec_control_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/egath_spec_control_mod.F90 rename to src/etrans/cpu/internal/egath_spec_control_mod.F90 diff --git a/src/etrans/etrans/internal/einv_trans_ctl_mod.F90 b/src/etrans/cpu/internal/einv_trans_ctl_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/einv_trans_ctl_mod.F90 rename to src/etrans/cpu/internal/einv_trans_ctl_mod.F90 diff --git a/src/etrans/etrans/internal/einv_trans_ctlad_mod.F90 b/src/etrans/cpu/internal/einv_trans_ctlad_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/einv_trans_ctlad_mod.F90 rename to src/etrans/cpu/internal/einv_trans_ctlad_mod.F90 diff --git a/src/etrans/etrans/internal/eledir_mod.F90 b/src/etrans/cpu/internal/eledir_mod.F90 similarity index 95% rename from src/etrans/etrans/internal/eledir_mod.F90 rename to src/etrans/cpu/internal/eledir_mod.F90 index 12da60d98..8f5f5ac83 100644 --- a/src/etrans/etrans/internal/eledir_mod.F90 +++ b/src/etrans/cpu/internal/eledir_mod.F90 @@ -58,10 +58,10 @@ SUBROUTINE ELEDIR(KM,KFC,KLED2,PFFT) USE TPM_DIM ,ONLY : R !USE TPM_GEOMETRY !USE TPM_TRANS +#ifdef WITH_FFT992 USE TPMALD_FFT ,ONLY : TALD -#ifdef WITH_FFTW -USE TPM_FFTW ,ONLY : TW, EXEC_EFFTW #endif +USE TPM_FFTW ,ONLY : TW, EXEC_EFFTW USE TPMALD_DIM ,ONLY : RALD USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS ! @@ -81,16 +81,15 @@ SUBROUTINE ELEDIR(KM,KFC,KLED2,PFFT) ITYPE=-1 IRLEN=R%NDGL+R%NNOEXTZG ICLEN=RALD%NDGLSUR+R%NNOEXTZG +#ifdef WITH_FFT992 IF( TALD%LFFT992 )THEN CALL FFT992(PFFT,TALD%TRIGSE,TALD%NFAXE,1,ICLEN,IRLEN,KFC,ITYPE) -#ifdef WITH_FFTW - ELSEIF( TW%LFFTW )THEN +#endif IOFF=1 CALL EXEC_EFFTW(ITYPE,IRLEN,ICLEN,IOFF,KFC,TW%LALL_FFTW,PFFT) -#endif - ELSE - CALL ABORT_TRANS('ELEDIR_MOD:ELEDIR: NO FFT PACKAGE SELECTED') +#ifdef WITH_FFT992 ENDIF +#endif ENDIF ! ------------------------------------------------------------------ diff --git a/src/etrans/etrans/internal/eledirad_mod.F90 b/src/etrans/cpu/internal/eledirad_mod.F90 similarity index 96% rename from src/etrans/etrans/internal/eledirad_mod.F90 rename to src/etrans/cpu/internal/eledirad_mod.F90 index 19dac6177..7d37b9c63 100644 --- a/src/etrans/etrans/internal/eledirad_mod.F90 +++ b/src/etrans/cpu/internal/eledirad_mod.F90 @@ -58,10 +58,10 @@ SUBROUTINE ELEDIRAD(KM,KFC,KLED2,PFFT) USE TPM_DIM ,ONLY : R !USE TPM_GEOMETRY !USE TPM_TRANS -#ifdef WITH_FFTW USE TPM_FFTW ,ONLY : TW, EXEC_EFFTW -#endif +#ifdef WITH_FFT992 USE TPMALD_FFT ,ONLY : TALD +#endif USE TPMALD_DIM ,ONLY : RALD USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS ! @@ -92,16 +92,16 @@ SUBROUTINE ELEDIRAD(KM,KFC,KLED2,PFFT) ITYPE=1 IRLEN=R%NDGL+R%NNOEXTZG ICLEN=RALD%NDGLSUR+R%NNOEXTZG +#ifdef WITH_FFT992 IF( TALD%LFFT992 )THEN CALL FFT992(PFFT,TALD%TRIGSE,TALD%NFAXE,1,RALD%NDGLSUR+R%NNOEXTZG,IRLEN,KFC,ITYPE) -#ifdef WITH_FFTW - ELSEIF( TW%LFFTW )THEN + ELSEIF ( ASSOCIATED(TW) )THEN +#endif IOFF=1 CALL EXEC_EFFTW(ITYPE,IRLEN,ICLEN,IOFF,KFC,TW%LALL_FFTW,PFFT) -#endif - ELSE - CALL ABORT_TRANS('ELEDIR_MOD:ELEDIR: NO FFT PACKAGE SELECTED') +#ifdef WITH_FFT992 ENDIF +#endif ZNORM=1.0_JPRB/(2.0_JPRB*REAL(R%NDGL+R%NNOEXTZG,JPRB)) DO JJ=1,R%NDGL+R%NNOEXTZG DO JF=1,KFC diff --git a/src/etrans/etrans/internal/eleinv_mod.F90 b/src/etrans/cpu/internal/eleinv_mod.F90 similarity index 95% rename from src/etrans/etrans/internal/eleinv_mod.F90 rename to src/etrans/cpu/internal/eleinv_mod.F90 index 350ca74dc..a830c6353 100644 --- a/src/etrans/etrans/internal/eleinv_mod.F90 +++ b/src/etrans/cpu/internal/eleinv_mod.F90 @@ -55,11 +55,11 @@ SUBROUTINE ELEINV(KM,KFC,KF_OUT_LT,PIA) USE TPM_DIM ,ONLY : R !USE TPM_GEOMETRY !USE TPM_TRANS -#ifdef WITH_FFTW USE TPM_FFTW ,ONLY : TW, EXEC_EFFTW -#endif USE TPMALD_DIM ,ONLY : RALD +#ifdef WITH_FFT992 USE TPMALD_FFT ,ONLY : TALD +#endif USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS ! @@ -85,16 +85,16 @@ SUBROUTINE ELEINV(KM,KFC,KF_OUT_LT,PIA) ITYPE=1 IRLEN=R%NDGL+R%NNOEXTZG ICLEN=RALD%NDGLSUR+R%NNOEXTZG +#ifdef WITH_FFT992 IF( TALD%LFFT992 )THEN CALL FFT992(PIA,TALD%TRIGSE,TALD%NFAXE,1,RALD%NDGLSUR+R%NNOEXTZG,IRLEN,KFC,ITYPE) -#ifdef WITH_FFTW - ELSEIF( TW%LFFTW )THEN + ELSE +#endif IOFF=1 CALL EXEC_EFFTW(ITYPE,IRLEN,ICLEN,IOFF,KFC,TW%LALL_FFTW,PIA) -#endif - ELSE - CALL ABORT_TRANS('ELEINV_MOD:ELEINV: NO FFT PACKAGE SELECTED') +#ifdef WITH_FFT992 ENDIF +#endif ENDIF IF (LHOOK) CALL DR_HOOK('ELEINV_MOD:ELEINV',1,ZHOOK_HANDLE) diff --git a/src/etrans/etrans/internal/eleinvad_mod.F90 b/src/etrans/cpu/internal/eleinvad_mod.F90 similarity index 95% rename from src/etrans/etrans/internal/eleinvad_mod.F90 rename to src/etrans/cpu/internal/eleinvad_mod.F90 index 15aa630cf..6a0a02e85 100644 --- a/src/etrans/etrans/internal/eleinvad_mod.F90 +++ b/src/etrans/cpu/internal/eleinvad_mod.F90 @@ -55,12 +55,11 @@ SUBROUTINE ELEINVAD(KM,KFC,KF_OUT_LT,PIA) USE TPM_DIM ,ONLY : R !USE TPM_GEOMETRY !USE TPM_TRANS -USE TPMALD_FFT ,ONLY : TALD -#ifdef WITH_FFTW USE TPM_FFTW ,ONLY : TW, EXEC_EFFTW -#endif USE TPMALD_DIM ,ONLY : RALD +#ifdef WITH_FFT992 USE TPMALD_FFT ,ONLY : TALD +#endif USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS ! @@ -84,16 +83,16 @@ SUBROUTINE ELEINVAD(KM,KFC,KF_OUT_LT,PIA) ITYPE=-1 IRLEN=R%NDGL+R%NNOEXTZG ICLEN=RALD%NDGLSUR+R%NNOEXTZG +#ifdef WITH_FFT992 IF( TALD%LFFT992 )THEN CALL FFT992(PIA,TALD%TRIGSE,TALD%NFAXE,1,ICLEN,IRLEN,KFC,ITYPE) -#ifdef WITH_FFTW - ELSEIF( TW%LFFTW )THEN + ELSE +#endif IOFF=1 CALL EXEC_EFFTW(ITYPE,IRLEN,ICLEN,IOFF,KFC,TW%LALL_FFTW,PIA) -#endif - ELSE - CALL ABORT_TRANS('ELEDIR_MOD:ELEINVAD: NO FFT PACKAGE SELECTED') +#ifdef WITH_FFT992 ENDIF +#endif ZNORM=2.0_JPRB*REAL(R%NDGL+R%NNOEXTZG,JPRB) DO JJ=1,1 DO JF=1,KFC diff --git a/src/etrans/cpu/internal/ellips.F90 b/src/etrans/cpu/internal/ellips.F90 new file mode 100644 index 000000000..63c73249e --- /dev/null +++ b/src/etrans/cpu/internal/ellips.F90 @@ -0,0 +1,89 @@ +! Jan-2011 P. Marguinaud Interface to thread-safe FA +SUBROUTINE ELLIPS (KSMAX,KMSMAX,KNTMP,KMTMP) +USE PARKIND1, ONLY : JPRD, JPIM +USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK +IMPLICIT NONE +! +! ***ELLIPS*** - General routine for computing elliptic truncation +! +! Purpose. +! -------- +! Computation of zonal and meridional limit wavenumbers within the ellipse +! Interface: +! ---------- +! *CALL* *ELLIPS * +! +! Explicit arguments : +! -------------------- +! +! Implicit arguments : +! -------------------- +! +! +! Method. +! ------- +! See documentation +! +! Externals. NONE. +! ---------- +! +! Reference. +! ---------- +! ARPEGE/ALADIN documentation +! +! Author. +! ------- +! G. Radnoti LACE 97/04/04 +! +! Modifications. +! +!------------------------------------------------------------- +! J.Vivoda, 99/05/19 treating NSMAX=0 and NMSMAX=0 +! O.Nuissier, 23/09/01 Change type of real (simple --> +! double precision) +! +! +INTEGER (KIND=JPIM) KSMAX, KMSMAX +INTEGER (KIND=JPIM) KNTMP(0:KMSMAX),KMTMP(0:KSMAX) +! +INTEGER (KIND=JPIM) JM, JN +! +REAL (KIND=JPRD) ZEPS, ZKN, ZKM, ZAUXIL +! +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE +IF (LHOOK) CALL DR_HOOK('ELLIPS',0,ZHOOK_HANDLE) +ZEPS=1.E-10 +ZAUXIL=0. +! +! 1. Computing meridional limit wavenumbers along zonal wavenumbers +! +DO JM=1,KMSMAX-1 +ZKN = REAL(KSMAX,JPRD)/REAL(KMSMAX,JPRD)* & +& SQRT(MAX(ZAUXIL,REAL(KMSMAX**2-JM**2,JPRD))) + KNTMP(JM)=INT(ZKN+ZEPS, JPIM) +ENDDO + +IF( KMSMAX.EQ.0 )THEN + KNTMP(0)=KSMAX +ELSE + KNTMP(0)=KSMAX + KNTMP(KMSMAX)=0 +ENDIF +! +! 2. Computing zonal limit wavenumbers along meridional wavenumbers +! +DO JN=1,KSMAX-1 +ZKM = REAL(KMSMAX,JPRD)/REAL(KSMAX,JPRD)* & + & SQRT(MAX(ZAUXIL,REAL(KSMAX**2-JN**2,JPRD))) + KMTMP(JN)=INT(ZKM+ZEPS, JPIM) +ENDDO + +IF( KSMAX.EQ.0 )THEN + KMTMP(0)=KMSMAX +ELSE + KMTMP(0)=KMSMAX + KMTMP(KSMAX)=0 +ENDIF +! +IF (LHOOK) CALL DR_HOOK('ELLIPS',1,ZHOOK_HANDLE) +END SUBROUTINE ELLIPS diff --git a/src/etrans/etrans/internal/eltdir_ctl_mod.F90 b/src/etrans/cpu/internal/eltdir_ctl_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/eltdir_ctl_mod.F90 rename to src/etrans/cpu/internal/eltdir_ctl_mod.F90 diff --git a/src/etrans/etrans/internal/eltdir_ctlad_mod.F90 b/src/etrans/cpu/internal/eltdir_ctlad_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/eltdir_ctlad_mod.F90 rename to src/etrans/cpu/internal/eltdir_ctlad_mod.F90 diff --git a/src/etrans/etrans/internal/eltdir_mod.F90 b/src/etrans/cpu/internal/eltdir_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/eltdir_mod.F90 rename to src/etrans/cpu/internal/eltdir_mod.F90 diff --git a/src/etrans/etrans/internal/eltdirad_mod.F90 b/src/etrans/cpu/internal/eltdirad_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/eltdirad_mod.F90 rename to src/etrans/cpu/internal/eltdirad_mod.F90 diff --git a/src/etrans/etrans/internal/eltinv_ctl_mod.F90 b/src/etrans/cpu/internal/eltinv_ctl_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/eltinv_ctl_mod.F90 rename to src/etrans/cpu/internal/eltinv_ctl_mod.F90 diff --git a/src/etrans/etrans/internal/eltinv_ctlad_mod.F90 b/src/etrans/cpu/internal/eltinv_ctlad_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/eltinv_ctlad_mod.F90 rename to src/etrans/cpu/internal/eltinv_ctlad_mod.F90 diff --git a/src/etrans/etrans/internal/eltinv_mod.F90 b/src/etrans/cpu/internal/eltinv_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/eltinv_mod.F90 rename to src/etrans/cpu/internal/eltinv_mod.F90 diff --git a/src/etrans/etrans/internal/eltinvad_mod.F90 b/src/etrans/cpu/internal/eltinvad_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/eltinvad_mod.F90 rename to src/etrans/cpu/internal/eltinvad_mod.F90 diff --git a/src/etrans/etrans/internal/eprfi1_mod.F90 b/src/etrans/cpu/internal/eprfi1_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/eprfi1_mod.F90 rename to src/etrans/cpu/internal/eprfi1_mod.F90 diff --git a/src/etrans/etrans/internal/eprfi1ad_mod.F90 b/src/etrans/cpu/internal/eprfi1ad_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/eprfi1ad_mod.F90 rename to src/etrans/cpu/internal/eprfi1ad_mod.F90 diff --git a/src/etrans/etrans/internal/eprfi1b_mod.F90 b/src/etrans/cpu/internal/eprfi1b_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/eprfi1b_mod.F90 rename to src/etrans/cpu/internal/eprfi1b_mod.F90 diff --git a/src/etrans/etrans/internal/eprfi1bad_mod.F90 b/src/etrans/cpu/internal/eprfi1bad_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/eprfi1bad_mod.F90 rename to src/etrans/cpu/internal/eprfi1bad_mod.F90 diff --git a/src/etrans/etrans/internal/eprfi2_mod.F90 b/src/etrans/cpu/internal/eprfi2_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/eprfi2_mod.F90 rename to src/etrans/cpu/internal/eprfi2_mod.F90 diff --git a/src/etrans/etrans/internal/eprfi2ad_mod.F90 b/src/etrans/cpu/internal/eprfi2ad_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/eprfi2ad_mod.F90 rename to src/etrans/cpu/internal/eprfi2ad_mod.F90 diff --git a/src/etrans/etrans/internal/eprfi2b_mod.F90 b/src/etrans/cpu/internal/eprfi2b_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/eprfi2b_mod.F90 rename to src/etrans/cpu/internal/eprfi2b_mod.F90 diff --git a/src/etrans/etrans/internal/eprfi2bad_mod.F90 b/src/etrans/cpu/internal/eprfi2bad_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/eprfi2bad_mod.F90 rename to src/etrans/cpu/internal/eprfi2bad_mod.F90 diff --git a/src/etrans/etrans/internal/eset_resol_mod.F90 b/src/etrans/cpu/internal/eset_resol_mod.F90 similarity index 93% rename from src/etrans/etrans/internal/eset_resol_mod.F90 rename to src/etrans/cpu/internal/eset_resol_mod.F90 index b5f1434a8..3b77bd002 100644 --- a/src/etrans/etrans/internal/eset_resol_mod.F90 +++ b/src/etrans/cpu/internal/eset_resol_mod.F90 @@ -10,16 +10,18 @@ SUBROUTINE ESET_RESOL(KRESOL) USE TPM_DISTR ,ONLY : D, DISTR_RESOL USE TPM_GEOMETRY ,ONLY : G, GEOM_RESOL USE TPM_FIELDS ,ONLY : F, FIELDS_RESOL -USE TPM_FFT ,ONLY : T, FFT_RESOL, TB, FFTB_RESOL -#ifdef WITH_FFTW -USE TPM_FFTW ,ONLY : TW, FFTW_RESOL +#ifdef WITH_FFT992 +USE TPM_FFT ,ONLY : T, FFT_RESOL #endif +USE TPM_FFTW ,ONLY : TW, FFTW_RESOL USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS USE TPMALD_DIM ,ONLY : RALD, ALDDIM_RESOL USE TPMALD_DISTR ,ONLY : DALD, ALDDISTR_RESOL +#ifdef WITH_FFT992 USE TPMALD_FFT ,ONLY : TALD, ALDFFT_RESOL +#endif USE TPMALD_FIELDS ,ONLY : FALD, ALDFIELDS_RESOL USE TPMALD_GEO ,ONLY : GALD, ALDGEO_RESOL ! @@ -52,15 +54,16 @@ SUBROUTINE ESET_RESOL(KRESOL) F => FIELDS_RESOL(NCUR_RESOL) G => GEOM_RESOL(NCUR_RESOL) D => DISTR_RESOL(NCUR_RESOL) +#ifdef WITH_FFT992 T => FFT_RESOL(NCUR_RESOL) - TB => FFTB_RESOL(NCUR_RESOL) -#ifdef WITH_FFTW - TW => FFTW_RESOL(NCUR_RESOL) #endif + TW => FFTW_RESOL(NCUR_RESOL) RALD => ALDDIM_RESOL(NCUR_RESOL) DALD => ALDDISTR_RESOL(NCUR_RESOL) +#ifdef WITH_FFT992 TALD => ALDFFT_RESOL(NCUR_RESOL) +#endif FALD => ALDFIELDS_RESOL(NCUR_RESOL) GALD => ALDGEO_RESOL(NCUR_RESOL) diff --git a/src/etrans/etrans/internal/esetup_dims_mod.F90 b/src/etrans/cpu/internal/esetup_dims_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/esetup_dims_mod.F90 rename to src/etrans/cpu/internal/esetup_dims_mod.F90 diff --git a/src/etrans/etrans/internal/esetup_geom_mod.F90 b/src/etrans/cpu/internal/esetup_geom_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/esetup_geom_mod.F90 rename to src/etrans/cpu/internal/esetup_geom_mod.F90 diff --git a/src/etrans/etrans/internal/espnorm_ctl_mod.F90 b/src/etrans/cpu/internal/espnorm_ctl_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/espnorm_ctl_mod.F90 rename to src/etrans/cpu/internal/espnorm_ctl_mod.F90 diff --git a/src/etrans/etrans/internal/espnormc_mod.F90 b/src/etrans/cpu/internal/espnormc_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/espnormc_mod.F90 rename to src/etrans/cpu/internal/espnormc_mod.F90 diff --git a/src/etrans/etrans/internal/espnormd_mod.F90 b/src/etrans/cpu/internal/espnormd_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/espnormd_mod.F90 rename to src/etrans/cpu/internal/espnormd_mod.F90 diff --git a/src/etrans/etrans/internal/espnsde_mod.F90 b/src/etrans/cpu/internal/espnsde_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/espnsde_mod.F90 rename to src/etrans/cpu/internal/espnsde_mod.F90 diff --git a/src/etrans/etrans/internal/espnsdead_mod.F90 b/src/etrans/cpu/internal/espnsdead_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/espnsdead_mod.F90 rename to src/etrans/cpu/internal/espnsdead_mod.F90 diff --git a/src/etrans/etrans/internal/eupdsp_mod.F90 b/src/etrans/cpu/internal/eupdsp_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/eupdsp_mod.F90 rename to src/etrans/cpu/internal/eupdsp_mod.F90 diff --git a/src/etrans/etrans/internal/eupdspad_mod.F90 b/src/etrans/cpu/internal/eupdspad_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/eupdspad_mod.F90 rename to src/etrans/cpu/internal/eupdspad_mod.F90 diff --git a/src/etrans/etrans/internal/eupdspb_mod.F90 b/src/etrans/cpu/internal/eupdspb_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/eupdspb_mod.F90 rename to src/etrans/cpu/internal/eupdspb_mod.F90 diff --git a/src/etrans/etrans/internal/eupdspbad_mod.F90 b/src/etrans/cpu/internal/eupdspbad_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/eupdspbad_mod.F90 rename to src/etrans/cpu/internal/eupdspbad_mod.F90 diff --git a/src/etrans/etrans/internal/euvtvd_comm_mod.F90 b/src/etrans/cpu/internal/euvtvd_comm_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/euvtvd_comm_mod.F90 rename to src/etrans/cpu/internal/euvtvd_comm_mod.F90 diff --git a/src/etrans/etrans/internal/euvtvd_mod.F90 b/src/etrans/cpu/internal/euvtvd_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/euvtvd_mod.F90 rename to src/etrans/cpu/internal/euvtvd_mod.F90 diff --git a/src/etrans/etrans/internal/euvtvdad_mod.F90 b/src/etrans/cpu/internal/euvtvdad_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/euvtvdad_mod.F90 rename to src/etrans/cpu/internal/euvtvdad_mod.F90 diff --git a/src/etrans/etrans/internal/evdtuv_mod.F90 b/src/etrans/cpu/internal/evdtuv_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/evdtuv_mod.F90 rename to src/etrans/cpu/internal/evdtuv_mod.F90 diff --git a/src/etrans/etrans/internal/evdtuvad_comm_mod.F90 b/src/etrans/cpu/internal/evdtuvad_comm_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/evdtuvad_comm_mod.F90 rename to src/etrans/cpu/internal/evdtuvad_comm_mod.F90 diff --git a/src/etrans/etrans/internal/evdtuvad_mod.F90 b/src/etrans/cpu/internal/evdtuvad_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/evdtuvad_mod.F90 rename to src/etrans/cpu/internal/evdtuvad_mod.F90 diff --git a/src/etrans/cpu/internal/fft992.F90 b/src/etrans/cpu/internal/fft992.F90 new file mode 100644 index 000000000..57aa6d373 --- /dev/null +++ b/src/etrans/cpu/internal/fft992.F90 @@ -0,0 +1,2377 @@ +! (C) Copyright 1998- ECMWF. +! (C) Copyright 2013- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + +! +! SUBROUTINE 'FFT992' - MULTIPLE FAST REAL PERIODIC TRANSFORM +! +! Author: Clive Temperton, January 1998 +! +! This routine is a modernized and enhanced version of FFT991 +! - Cray directives and ancient Fortran constructs removed +! - "vector chopping" removed +! - WORK array is now dynamically allocated +! - stride in WORK array is now always 1 +! +! REAL TRANSFORM OF LENGTH N PERFORMED BY REMOVING REDUNDANT +! OPERATIONS FROM COMPLEX TRANSFORM OF LENGTH N +! +! A IS THE ARRAY CONTAINING INPUT & OUTPUT DATA +! TRIGS IS A PREVIOUSLY PREPARED LIST OF TRIG FUNCTION VALUES +! IFAX IS A PREVIOUSLY PREPARED LIST OF FACTORS OF N +! INC IS THE INCREMENT WITHIN EACH DATA 'VECTOR' +! (E.G. INC=1 FOR CONSECUTIVELY STORED DATA) +! JUMP IS THE INCREMENT BETWEEN THE START OF EACH DATA VECTOR +! N IS THE LENGTH OF THE DATA VECTORS +! LOT IS THE NUMBER OF DATA VECTORS +! ISIGN = +1 FOR TRANSFORM FROM SPECTRAL TO GRIDPOINT +! = -1 FOR TRANSFORM FROM GRIDPOINT TO SPECTRAL +! +! ORDERING OF COEFFICIENTS: +! A(0),B(0),A(1),B(1),A(2),B(2),...,A(N/2),B(N/2) +! WHERE B(0)=B(N/2)=0; (N+2) LOCATIONS REQUIRED +! +! ORDERING OF DATA: +! X(0),X(1),X(2),...,X(N-1), 0 , 0 ; (N+2) LOCATIONS REQUIRED +! +! VECTORIZATION IS ACHIEVED BY DOING THE TRANSFORMS IN PARALLEL +! +! N MUST BE COMPOSED OF FACTORS 2,3 & 5 BUT DOES NOT HAVE TO BE EVEN +! +! DEFINITION OF TRANSFORMS: +! ------------------------- +! +! ISIGN=+1: X(J)=SUM(K=0,...,N-1)(C(K)*EXP(2*I*J*K*PI/N)) +! WHERE C(K)=A(K)+I*B(K) AND C(N-K)=A(K)-I*B(K) +! +! ISIGN=-1: A(K)=(1/N)*SUM(J=0,...,N-1)(X(J)*COS(2*J*K*PI/N)) +! B(K)=-(1/N)*SUM(J=0,...,N-1)(X(J)*SIN(2*J*K*PI/N)) +! +#ifdef MATHKEISAN +! MathKeisan is a scientific library optimized for NEC (www.mathkeisan.com) + + SUBROUTINE FFT992(A,TRIGS_,IFAX_,INC,JUMP,N,LOT,ISIGN) +!AUTOPROMOTE + USE PARKIND1, ONLY : JPIM, JPRB + USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK + IMPLICIT NONE + INTEGER(KIND=JPIM) :: N + REAL(KIND=JPRB) :: A(*) + REAL(KIND=JPRB) :: TRIGS_(N) + INTEGER(KIND=JPIM) :: IFAX_(10) + + INTEGER(KIND=JPIM) :: INC + INTEGER(KIND=JPIM) :: JUMP + INTEGER(KIND=JPIM) :: LOT + INTEGER(KIND=JPIM) :: ISIGN + + REAL(KIND=JPRB),ALLOCATABLE,DIMENSION(:),SAVE :: WORK , TRIGS + INTEGER(KIND=JPIM),SAVE :: IFAX (32) + + + INTEGER(KIND=JPIM), SAVE :: N_OLD=-1 + INTEGER(KIND=JPIM), SAVE :: LOT_OLD=-1 + +!$OMP threadprivate(ifax,n_old,lot_old,trigs,work) + + + REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + IF (LHOOK) CALL DR_HOOK('FFT992',0,ZHOOK_HANDLE) + IF (N .NE. N_OLD) THEN + + IF( ALLOCATED( WORK ) ) DEALLOCATE( WORK ) + IF( ALLOCATED( TRIGS ) ) DEALLOCATE( TRIGS ) + + ALLOCATE(WORK(3*N*LOT)) + ALLOCATE(TRIGS(2*N)) + + CALL DFTFAX ( N, IFAX, TRIGS ) + + N_OLD = N + LOT_OLD = LOT + + ELSE + + IF (LOT .GT. LOT_OLD) THEN + + IF( ALLOCATED( WORK ) ) DEALLOCATE( WORK ) + ALLOCATE(WORK(3*N*LOT)) + LOT_OLD = LOT + + ENDIF + + ENDIF + + CALL DFFTMLT ( A, WORK, TRIGS, IFAX, INC, JUMP, N, LOT, ISIGN ) + + IF (LHOOK) CALL DR_HOOK('FFT992',1,ZHOOK_HANDLE) + RETURN + + END SUBROUTINE FFT992 +#else +! +! SUBROUTINE 'FFT992' - MULTIPLE FAST REAL PERIODIC TRANSFORM +! +! Author: Clive Temperton, January 1998 +! +! This routine is a modernized and enhanced version of FFT991 +! - Cray directives and ancient Fortran constructs removed +! - "vector chopping" removed +! - WORK array is now dynamically allocated +! - stride in WORK array is now always 1 +! +! REAL TRANSFORM OF LENGTH N PERFORMED BY REMOVING REDUNDANT +! OPERATIONS FROM COMPLEX TRANSFORM OF LENGTH N +! +! A IS THE ARRAY CONTAINING INPUT & OUTPUT DATA +! TRIGS IS A PREVIOUSLY PREPARED LIST OF TRIG FUNCTION VALUES +! IFAX IS A PREVIOUSLY PREPARED LIST OF FACTORS OF N +! INC IS THE INCREMENT WITHIN EACH DATA 'VECTOR' +! (E.G. INC=1 FOR CONSECUTIVELY STORED DATA) +! JUMP IS THE INCREMENT BETWEEN THE START OF EACH DATA VECTOR +! N IS THE LENGTH OF THE DATA VECTORS +! LOT IS THE NUMBER OF DATA VECTORS +! ISIGN = +1 FOR TRANSFORM FROM SPECTRAL TO GRIDPOINT +! = -1 FOR TRANSFORM FROM GRIDPOINT TO SPECTRAL +! +! ORDERING OF COEFFICIENTS: +! A(0),B(0),A(1),B(1),A(2),B(2),...,A(N/2),B(N/2) +! WHERE B(0)=B(N/2)=0; (N+2) LOCATIONS REQUIRED +! +! ORDERING OF DATA: +! X(0),X(1),X(2),...,X(N-1), 0 , 0 ; (N+2) LOCATIONS REQUIRED +! +! VECTORIZATION IS ACHIEVED BY DOING THE TRANSFORMS IN PARALLEL +! +! N MUST BE COMPOSED OF FACTORS 2,3 & 5 BUT DOES NOT HAVE TO BE EVEN +! +! DEFINITION OF TRANSFORMS: +! ------------------------- +! +! ISIGN=+1: X(J)=SUM(K=0,...,N-1)(C(K)*EXP(2*I*J*K*PI/N)) +! WHERE C(K)=A(K)+I*B(K) AND C(N-K)=A(K)-I*B(K) +! +! ISIGN=-1: A(K)=(1/N)*SUM(J=0,...,N-1)(X(J)*COS(2*J*K*PI/N)) +! B(K)=-(1/N)*SUM(J=0,...,N-1)(X(J)*SIN(2*J*K*PI/N)) +! + SUBROUTINE FFT992(A,TRIGS,IFAX,INC,JUMP,N,LOT,ISIGN) +!disabled for now. REK.!DEC$ OPTIMIZE:3 +!AUTOPROMOTE + USE PARKIND1, ONLY : JPIM, JPRB + USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK + IMPLICIT NONE +! + INTEGER(KIND=JPIM) :: N + INTEGER(KIND=JPIM) :: INC + INTEGER(KIND=JPIM) :: JBASE + INTEGER(KIND=JPIM) :: JUMP + INTEGER(KIND=JPIM) :: J,JJ,JUMPA + INTEGER(KIND=JPIM) :: LOT + INTEGER(KIND=JPIM) :: K,LA,NFAX + INTEGER(KIND=JPIM) :: ISIGN + INTEGER(KIND=JPIM) :: I,IA,IBASE,IERR,IFAC,IGO,II,INCA,IX + + REAL(KIND=JPRB) :: A(*) + REAL(KIND=JPRB) :: TRIGS(N) + INTEGER(KIND=JPIM) :: IFAX(10) +! Dynamically allocated work array: + REAL(KIND=JPRB) :: WORK(N*LOT+1) + LOGICAL :: LIPL +! + REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + IF (LHOOK) CALL DR_HOOK('FFT992',0,ZHOOK_HANDLE) + NFAX=IFAX(1) + IF (ISIGN.EQ.+1) THEN +! +! ISIGN=+1, SPECTRAL TO GRIDPOINT TRANSFORM +! ----------------------------------------- +! + I=1 +!OCL NOVREC +!DEC$ IVDEP + DO J=1,LOT + A(I+INC)=0.5_JPRB*A(I) + I=I+JUMP + ENDDO + IF (MOD(N,2).EQ.0) THEN + I=N*INC+1 +!OCL NOVREC +!DEC$ IVDEP + DO J=1,LOT + A(I)=0.5_JPRB*A(I) + I=I+JUMP + ENDDO + ENDIF +! + IA=INC+1 + LA=1 + IGO=+1 +! + DO K=1,NFAX + IFAC=IFAX(K+1) + IERR=-1 + IF (K.EQ.NFAX.AND.NFAX.GT.2.AND.IGO.EQ.+1) THEN + LIPL=.TRUE. + ELSE + LIPL=.FALSE. + ENDIF + IF (INC.EQ.1.AND.JUMP.LT.(2*N).AND. & + & K.GT.1.AND.K.LT.(NFAX-MOD(NFAX,2))) THEN + INCA=LOT + JUMPA=1 + ELSE + INCA=INC + JUMPA=JUMP + ENDIF + IF (IGO.EQ.+1) THEN +!DEC$ FORCEINLINE + CALL RPASSF(A(IA),A(IA+LA*INCA),WORK(1),WORK(IFAC*LA*LOT+1), & + & TRIGS,INCA,LOT,JUMPA,1,LOT,N,IFAC,LA,IERR,LIPL) + ELSE +!DEC$ FORCEINLINE + CALL RPASSF(WORK(1),WORK(LA*LOT+1),A(IA),A(IA+IFAC*LA*INCA), & + & TRIGS,LOT,INCA,1,JUMPA,LOT,N,IFAC,LA,IERR,LIPL) + ENDIF + IF (IERR.NE.0) THEN + IF (IERR.EQ.2) WRITE(6,901) IFAC + IF (IERR.EQ.3) WRITE(6,902) IFAC + IF (LHOOK) CALL DR_HOOK('FFT992',1,ZHOOK_HANDLE) + RETURN + ENDIF + LA=IFAC*LA + IGO=-IGO + IA=1 + ENDDO +! +! IF NECESSARY, COPY RESULTS BACK TO A +! ------------------------------------ + IF (NFAX.EQ.1) THEN + IBASE=1 + JBASE=1 + DO JJ=1,N + I=IBASE + J=JBASE + DO II=1,LOT + A(J)=WORK(I) + I=I+1 + J=J+JUMP + ENDDO + IBASE=IBASE+LOT + JBASE=JBASE+INC + ENDDO + ENDIF +! +! FILL IN ZEROS AT END +! -------------------- + IX=N*INC+1 +!OCL NOVREC +!DEC$ IVDEP + DO J=1,LOT + A(IX)=0.0_JPRB + A(IX+INC)=0.0_JPRB + IX=IX+JUMP + ENDDO +! + ELSEIF (ISIGN.EQ.-1) THEN +! +! ISIGN=-1, GRIDPOINT TO SPECTRAL TRANSFORM +! ----------------------------------------- + IA=1 + LA=N + IGO=+1 +! + DO K=1,NFAX + IFAC=IFAX(NFAX+2-K) + LA=LA/IFAC + IERR=-1 + IF (K.EQ.1.AND.NFAX.GT.2.AND.MOD(NFAX,2).EQ.1) THEN + LIPL=.TRUE. + ELSE + LIPL=.FALSE. + ENDIF + IF (INC.EQ.1.AND.JUMP.LT.(2*N).AND. & + & K.GT.(1+MOD(NFAX,2)).AND.K.LT.NFAX) THEN + INCA=LOT + JUMPA=1 + ELSE + INCA=INC + JUMPA=JUMP + ENDIF + IF (IGO.EQ.+1) THEN +!DEC$ FORCEINLINE + CALL QPASSF(A(IA),A(IA+IFAC*LA*INCA),WORK(1),WORK(LA*LOT+1), & + & TRIGS,INCA,LOT,JUMPA,1,LOT,N,IFAC,LA,IERR,LIPL) + ELSE +!DEC$ FORCEINLINE + CALL QPASSF(WORK(1),WORK(IFAC*LA*LOT+1),A(IA),A(IA+LA*INCA), & + & TRIGS,LOT,INCA,1,JUMPA,LOT,N,IFAC,LA,IERR,LIPL) + ENDIF + IF (IERR.NE.0) THEN + IF (IERR.EQ.2) WRITE(6,901) IFAC + IF (IERR.EQ.3) WRITE(6,902) IFAC + IF (LHOOK) CALL DR_HOOK('FFT992',1,ZHOOK_HANDLE) + RETURN + ENDIF + IF (LIPL) THEN + IA=1 + ELSE + IGO=-IGO + IA=INC+1 + ENDIF + ENDDO +! +! IF NECESSARY, COPY RESULTS BACK TO A +! ------------------------------------ + IF (NFAX.EQ.1) THEN + IBASE=1 + JBASE=INC+1 + DO JJ=1,N + I=IBASE + J=JBASE + DO II=1,LOT + A(J)=WORK(I) + I=I+1 + J=J+JUMP + ENDDO + IBASE=IBASE+LOT + JBASE=JBASE+INC + ENDDO + ENDIF +! +! SHIFT A(0) & FILL IN ZERO IMAG PARTS +! ------------------------------------ + IX=1 +!OCL NOVREC +!DEC$ IVDEP + DO J=1,LOT + A(IX)=A(IX+INC) + A(IX+INC)=0.0_JPRB + IX=IX+JUMP + ENDDO + IF (MOD(N,2).EQ.0) THEN + IX=(N+1)*INC+1 + DO J=1,LOT + A(IX)=0.0_JPRB + IX=IX+JUMP + ENDDO + ENDIF +! + ENDIF +! +! FORMAT STATEMENTS FOR ERROR MESSAGES: + 901 FORMAT(' FACTOR =',I3,' NOT CATERED FOR') + 902 FORMAT(' FACTOR =',I3,' ONLY CATERED FOR IF LA*IFAC=N') +! + IF (LHOOK) CALL DR_HOOK('FFT992',1,ZHOOK_HANDLE) + + CONTAINS +! SUBROUTINE 'RPASSF' - PERFORMS ONE PASS THROUGH DATA AS PART +! OF MULTIPLE REAL FFT (FOURIER SYNTHESIS) ROUTINE +! +! A IS FIRST REAL INPUT VECTOR +! EQUIVALENCE B(1) WITH A (LA*INC1+1) +! C IS FIRST REAL OUTPUT VECTOR +! EQUIVALENCE D(1) WITH C(IFAC*LA*INC2+1) +! TRIGS IS A PRECALCULATED LIST OF SINES & COSINES +! INC1 IS THE ADDRESSING INCREMENT FOR A +! INC2 IS THE ADDRESSING INCREMENT FOR C +! INC3 IS THE INCREMENT BETWEEN INPUT VECTORS A +! INC4 IS THE INCREMENT BETWEEN OUTPUT VECTORS C +! LOT IS THE NUMBER OF VECTORS +! N IS THE LENGTH OF THE VECTORS +! IFAC IS THE CURRENT FACTOR OF N +! LA IS THE PRODUCT OF PREVIOUS FACTORS +! IERR IS AN ERROR INDICATOR: +! 0 - PASS COMPLETED WITHOUT ERROR +! 1 - LOT GREATER THAN 64 +! 2 - IFAC NOT CATERED FOR +! 3 - IFAC ONLY CATERED FOR IF LA=N/IFAC +! LIPL=.T. => RESULTS ARE RETURNED TO INPUT ARRAY +! (ONLY VALID IF LA=N/IFAC, I.E. ON LAST PASS) +! +!----------------------------------------------------------------------- +! + SUBROUTINE RPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & + & LA,IERR,LIPL) +!AUTOPROMOTE +! + USE PARKIND1, ONLY : JPIM, JPRB + USE YOMHOOK , ONLY : DR_HOOK, JPHOOK +! + IMPLICIT NONE +! + INTEGER(KIND=JPIM) :: N + REAL(KIND=JPRB) :: A(*) + REAL(KIND=JPRB) :: B(*) + REAL(KIND=JPRB) :: C(*) + REAL(KIND=JPRB) :: D(*) + REAL(KIND=JPRB) :: TRIGS(N) + REAL(KIND=JPRB) :: A10,A11,A20,A21 + REAL(KIND=JPRB) :: B10,B11,B20,B21 + REAL(KIND=JPRB) :: C1,C2,C3,C4,C5 + REAL(KIND=JPRB) :: S1,S2,S3,S4,S5 + REAL(KIND=JPRB) :: SIN36,SIN45,SIN60,SIN72 + REAL(KIND=JPRB) :: SSIN36,SSIN45,SSIN60,SSIN72 + REAL(KIND=JPRB) :: QRT5,QQRT5 + REAL(KIND=JPRB) :: T1,T2,T3,T4,T5,T6,T7 + INTEGER(KIND=JPIM) :: IERR + INTEGER(KIND=JPIM) :: INC1 + INTEGER(KIND=JPIM) :: INC2 + INTEGER(KIND=JPIM) :: INC3 + INTEGER(KIND=JPIM) :: INC4 + INTEGER(KIND=JPIM) :: LOT + INTEGER(KIND=JPIM) :: IFAC + INTEGER(KIND=JPIM) :: LA + INTEGER(KIND=JPIM) :: INC21,IINK,IJK,ILOT,ILA + INTEGER(KIND=JPIM) :: I,IA,IB,IBAD,IBASE,IC,ID,IE,IF + INTEGER(KIND=JPIM) :: J,JA,JB,JBASE,JC,JD,JE,JF,JG,JH,JINK,JUMP + INTEGER(KIND=JPIM) :: K,KB,KC,KD,KE,KF,KSTOP + INTEGER(KIND=JPIM) :: L,M + LOGICAL :: LIPL +! + DATA SIN36/0.587785252292473_JPRB/,SIN72/0.951056516295154_JPRB/, & + & QRT5/0.559016994374947_JPRB/,SIN60/0.866025403784437_JPRB/ +! + M=N/IFAC + IINK=LA*INC1 + JINK=LA*INC2 + JUMP=(IFAC-1)*JINK + KSTOP=(N-IFAC)/(2*IFAC) +! + IBASE=0 + JBASE=0 + IBAD=0 +! +! Increase the vector length by fusing the loops if the +! data layout is appropriate: + IF (INC1.EQ.LOT.AND.INC2.EQ.LOT.AND.INC3.EQ.1.AND.INC4.EQ.1) THEN + ILA=1 + ILOT=LA*LOT + INC21=LA*LOT + ELSE + ILA=LA + ILOT=LOT + INC21=INC2 + ENDIF +! + IF (IFAC.EQ.2) THEN +! +! CODING FOR FACTOR 2 +! ------------------- + 200 CONTINUE + IA=1 + IB=IA+(2*M-LA)*INC1 + JA=1 + JB=JA+JINK +! + IF (LA.NE.M) THEN +! + DO 220 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 210 IJK=1,ILOT + C(JA+J)=A(IA+I)+A(IB+I) + C(JB+J)=A(IA+I)-A(IB+I) + I=I+INC3 + J=J+INC4 + 210 CONTINUE + IBASE=IBASE+INC1 + JBASE=JBASE+INC21 + 220 CONTINUE + IA=IA+IINK + IINK=2*IINK + IB=IB-IINK + IBASE=0 + JBASE=JBASE+JUMP + JUMP=2*JUMP+JINK +! + IF (IA.LT.IB) THEN + DO 250 K=LA,KSTOP,LA + KB=K+K + C1=TRIGS(KB+1) + S1=TRIGS(KB+2) + IBASE=0 + DO 240 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 230 IJK=1,ILOT + C(JA+J)=A(IA+I)+A(IB+I) + D(JA+J)=B(IA+I)-B(IB+I) + C(JB+J)=C1*(A(IA+I)-A(IB+I))-S1*(B(IA+I)+B(IB+I)) + D(JB+J)=S1*(A(IA+I)-A(IB+I))+C1*(B(IA+I)+B(IB+I)) + I=I+INC3 + J=J+INC4 + 230 CONTINUE + IBASE=IBASE+INC1 + JBASE=JBASE+INC21 + 240 CONTINUE + IA=IA+IINK + IB=IB-IINK + JBASE=JBASE+JUMP + 250 CONTINUE + ENDIF +! + IF (IA.EQ.IB) THEN + IBASE=0 + DO 280 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 270 IJK=1,ILOT + C(JA+J)=A(IA+I) + C(JB+J)=-B(IA+I) + I=I+INC3 + J=J+INC4 + 270 CONTINUE + IBASE=IBASE+INC1 + JBASE=JBASE+INC21 + 280 CONTINUE + ENDIF +! + ELSE !!! Case LA=M + IF (LIPL) THEN + DO 294 L=1,ILA + I=IBASE +!OCL NOVREC +!NEC$ ivdep + DO 292 IJK=1,ILOT + T1=2.0*(A(IA+I)-A(IB+I)) + A(IA+I)=2.0_JPRB*(A(IA+I)+A(IB+I)) + A(IB+I)=T1 + I=I+INC3 + 292 CONTINUE + IBASE=IBASE+INC1 + 294 CONTINUE + ELSE + DO 298 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 296 IJK=1,ILOT + C(JA+J)=2.0_JPRB*(A(IA+I)+A(IB+I)) + C(JB+J)=2.0_JPRB*(A(IA+I)-A(IB+I)) + I=I+INC3 + J=J+INC4 + 296 CONTINUE + IBASE=IBASE+INC1 + JBASE=JBASE+INC21 + 298 CONTINUE + ENDIF + ENDIF +! + ELSEIF (IFAC.EQ.3) THEN +! +! CODING FOR FACTOR 3 +! ------------------- + 300 CONTINUE + IA=1 + IB=IA+(2*M-LA)*INC1 + IC=IB + JA=1 + JB=JA+JINK + JC=JB+JINK +! + IF (LA.NE.M) THEN +! + DO 320 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 310 IJK=1,ILOT + C(JA+J)=A(IA+I)+A(IB+I) + C(JB+J)=(A(IA+I)-0.5_JPRB*A(IB+I))-(SIN60*(B(IB+I))) + C(JC+J)=(A(IA+I)-0.5_JPRB*A(IB+I))+(SIN60*(B(IB+I))) + I=I+INC3 + J=J+INC4 + 310 CONTINUE + IBASE=IBASE+INC1 + JBASE=JBASE+INC21 + 320 CONTINUE + IA=IA+IINK + IINK=2*IINK + IB=IB+IINK + IC=IC-IINK + JBASE=JBASE+JUMP + JUMP=2*JUMP+JINK +! + IF (IA.LT.IC) THEN + DO 350 K=LA,KSTOP,LA + KB=K+K + KC=KB+KB + C1=TRIGS(KB+1) + S1=TRIGS(KB+2) + C2=TRIGS(KC+1) + S2=TRIGS(KC+2) + IBASE=0 + DO 340 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 330 IJK=1,ILOT + C(JA+J)=A(IA+I)+(A(IB+I)+A(IC+I)) + D(JA+J)=B(IA+I)+(B(IB+I)-B(IC+I)) + C(JB+J)= & + & C1*((A(IA+I)-0.5_JPRB*(A(IB+I)+A(IC+I)))- & + & (SIN60*(B(IB+I)+B(IC+I)))) & + & -S1*((B(IA+I)-0.5_JPRB*(B(IB+I)-B(IC+I)))+ & + & (SIN60*(A(IB+I)-A(IC+I)))) + D(JB+J)= & + & S1*((A(IA+I)-0.5_JPRB*(A(IB+I)+A(IC+I)))- & + & (SIN60*(B(IB+I)+B(IC+I)))) & + & +C1*((B(IA+I)-0.5_JPRB*(B(IB+I)-B(IC+I)))+ & + & (SIN60*(A(IB+I)-A(IC+I)))) + C(JC+J)= & + & C2*((A(IA+I)-0.5_JPRB*(A(IB+I)+A(IC+I)))+ & + & (SIN60*(B(IB+I)+B(IC+I)))) & + & -S2*((B(IA+I)-0.5_JPRB*(B(IB+I)-B(IC+I)))- & + & (SIN60*(A(IB+I)-A(IC+I)))) + D(JC+J)= & + & S2*((A(IA+I)-0.5_JPRB*(A(IB+I)+A(IC+I)))+ & + & (SIN60*(B(IB+I)+B(IC+I)))) & + & +C2*((B(IA+I)-0.5_JPRB*(B(IB+I)-B(IC+I)))- & + & (SIN60*(A(IB+I)-A(IC+I)))) + I=I+INC3 + J=J+INC4 + 330 CONTINUE + IBASE=IBASE+INC1 + JBASE=JBASE+INC21 + 340 CONTINUE + IA=IA+IINK + IB=IB+IINK + IC=IC-IINK + JBASE=JBASE+JUMP + 350 CONTINUE + ENDIF +! + IF (IA.EQ.IC) THEN + IBASE=0 + DO 380 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 370 IJK=1,ILOT + C(JA+J)=A(IA+I)+A(IB+I) + C(JB+J)=(0.5_JPRB*A(IA+I)-A(IB+I))-(SIN60*B(IA+I)) + C(JC+J)=-(0.5_JPRB*A(IA+I)-A(IB+I))-(SIN60*B(IA+I)) + I=I+INC3 + J=J+INC4 + 370 CONTINUE + IBASE=IBASE+INC1 + JBASE=JBASE+INC21 + 380 CONTINUE + ENDIF +! + ELSE !!! Case LA=M + SSIN60=2.0*SIN60 + IF (LIPL) THEN + DO 394 L=1,ILA + I=IBASE +!OCL NOVREC +!NEC$ ivdep + DO 392 IJK=1,ILOT + T1=(2.0_JPRB*A(IA+I)-A(IB+I))-(SSIN60*B(IB+I)) + T2=(2.0_JPRB*A(IA+I)-A(IB+I))+(SSIN60*B(IB+I)) + A(IA+I)=2.0_JPRB*(A(IA+I)+A(IB+I)) + A(IB+I)=T1 + B(IB+I)=T2 + I=I+INC3 + 392 CONTINUE + IBASE=IBASE+INC1 + 394 CONTINUE + ELSE + DO 398 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 396 IJK=1,ILOT + C(JA+J)=2.0_JPRB*(A(IA+I)+A(IB+I)) + C(JB+J)=(2.0_JPRB*A(IA+I)-A(IB+I))-(SSIN60*B(IB+I)) + C(JC+J)=(2.0_JPRB*A(IA+I)-A(IB+I))+(SSIN60*B(IB+I)) + I=I+INC3 + J=J+INC4 + 396 CONTINUE + IBASE=IBASE+INC1 + JBASE=JBASE+INC21 + 398 CONTINUE + ENDIF + ENDIF +! + ELSEIF (IFAC.EQ.4) THEN +! +! CODING FOR FACTOR 4 +! ------------------- + 400 CONTINUE + IA=1 + IB=IA+(2*M-LA)*INC1 + IC=IB+2*M*INC1 + ID=IB + JA=1 + JB=JA+JINK + JC=JB+JINK + JD=JC+JINK +! + IF (LA.NE.M) THEN +! + DO 420 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 410 IJK=1,ILOT + C(JA+J)=(A(IA+I)+A(IC+I))+A(IB+I) + C(JB+J)=(A(IA+I)-A(IC+I))-B(IB+I) + C(JC+J)=(A(IA+I)+A(IC+I))-A(IB+I) + C(JD+J)=(A(IA+I)-A(IC+I))+B(IB+I) + I=I+INC3 + J=J+INC4 + 410 CONTINUE + IBASE=IBASE+INC1 + JBASE=JBASE+INC21 + 420 CONTINUE + IA=IA+IINK + IINK=2*IINK + IB=IB+IINK + IC=IC-IINK + ID=ID-IINK + JBASE=JBASE+JUMP + JUMP=2*JUMP+JINK +! + IF (IB.LT.IC) THEN + DO 450 K=LA,KSTOP,LA + KB=K+K + KC=KB+KB + KD=KC+KB + C1=TRIGS(KB+1) + S1=TRIGS(KB+2) + C2=TRIGS(KC+1) + S2=TRIGS(KC+2) + C3=TRIGS(KD+1) + S3=TRIGS(KD+2) + IBASE=0 + DO 440 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 430 IJK=1,ILOT + C(JA+J)=(A(IA+I)+A(IC+I))+(A(IB+I)+A(ID+I)) + D(JA+J)=(B(IA+I)-B(IC+I))+(B(IB+I)-B(ID+I)) + C(JC+J)= & + & C2*((A(IA+I)+A(IC+I))-(A(IB+I)+A(ID+I))) & + & -S2*((B(IA+I)-B(IC+I))-(B(IB+I)-B(ID+I))) + D(JC+J)= & + & S2*((A(IA+I)+A(IC+I))-(A(IB+I)+A(ID+I))) & + & +C2*((B(IA+I)-B(IC+I))-(B(IB+I)-B(ID+I))) + C(JB+J)= & + & C1*((A(IA+I)-A(IC+I))-(B(IB+I)+B(ID+I))) & + & -S1*((B(IA+I)+B(IC+I))+(A(IB+I)-A(ID+I))) + D(JB+J)= & + & S1*((A(IA+I)-A(IC+I))-(B(IB+I)+B(ID+I))) & + & +C1*((B(IA+I)+B(IC+I))+(A(IB+I)-A(ID+I))) + C(JD+J)= & + & C3*((A(IA+I)-A(IC+I))+(B(IB+I)+B(ID+I))) & + & -S3*((B(IA+I)+B(IC+I))-(A(IB+I)-A(ID+I))) + D(JD+J)= & + & S3*((A(IA+I)-A(IC+I))+(B(IB+I)+B(ID+I))) & + & +C3*((B(IA+I)+B(IC+I))-(A(IB+I)-A(ID+I))) + I=I+INC3 + J=J+INC4 + 430 CONTINUE + IBASE=IBASE+INC1 + JBASE=JBASE+INC21 + 440 CONTINUE + IA=IA+IINK + IB=IB+IINK + IC=IC-IINK + ID=ID-IINK + JBASE=JBASE+JUMP + 450 CONTINUE + ENDIF +! + IF (IB.EQ.IC) THEN + IBASE=0 + SIN45=SQRT(0.5_JPRB) + DO 480 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 470 IJK=1,ILOT + C(JA+J)=A(IA+I)+A(IB+I) + C(JB+J)=SIN45*((A(IA+I)-A(IB+I))-(B(IA+I)+B(IB+I))) + C(JC+J)=B(IB+I)-B(IA+I) + C(JD+J)=-SIN45*((A(IA+I)-A(IB+I))+(B(IA+I)+B(IB+I))) + I=I+INC3 + J=J+INC4 + 470 CONTINUE + IBASE=IBASE+INC1 + JBASE=JBASE+INC21 + 480 CONTINUE + ENDIF +! + ELSE !!! Case LA=M + IF (LIPL) THEN + DO 494 L=1,ILA + I=IBASE +!OCL NOVREC +!NEC$ ivdep + DO 492 IJK=1,ILOT + T1=2.0_JPRB*((A(IA+I)-A(IC+I))-B(IB+I)) + T2=2.0_JPRB*((A(IA+I)+A(IC+I))-A(IB+I)) + T3=2.0_JPRB*((A(IA+I)-A(IC+I))+B(IB+I)) + A(IA+I)=2.0_JPRB*((A(IA+I)+A(IC+I))+A(IB+I)) + A(IB+I)=T1 + B(IB+I)=T2 + A(IC+I)=T3 + I=I+INC3 + 492 CONTINUE + IBASE=IBASE+INC1 + 494 CONTINUE + ELSE + DO 498 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 496 IJK=1,ILOT + C(JA+J)=2.0_JPRB*((A(IA+I)+A(IC+I))+A(IB+I)) + C(JB+J)=2.0_JPRB*((A(IA+I)-A(IC+I))-B(IB+I)) + C(JC+J)=2.0_JPRB*((A(IA+I)+A(IC+I))-A(IB+I)) + C(JD+J)=2.0_JPRB*((A(IA+I)-A(IC+I))+B(IB+I)) + I=I+INC3 + J=J+INC4 + 496 CONTINUE + IBASE=IBASE+INC1 + JBASE=JBASE+INC21 + 498 CONTINUE + ENDIF + ENDIF +! + ELSEIF (IFAC.EQ.5) THEN +! +! CODING FOR FACTOR 5 +! ------------------- + 500 CONTINUE + IA=1 + IB=IA+(2*M-LA)*INC1 + IC=IB+2*M*INC1 + ID=IC + IE=IB + JA=1 + JB=JA+JINK + JC=JB+JINK + JD=JC+JINK + JE=JD+JINK +! + IF (LA.NE.M) THEN +! + DO 520 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 510 IJK=1,ILOT + C(JA+J)=A(IA+I)+(A(IB+I)+A(IC+I)) + C(JB+J)=((A(IA+I)-0.25_JPRB*(A(IB+I)+A(IC+I)))+ & + & QRT5*(A(IB+I)-A(IC+I)))-(SIN72*B(IB+I)+SIN36*B(IC+I)) + C(JC+J)=((A(IA+I)-0.25_JPRB*(A(IB+I)+A(IC+I)))- & + & QRT5*(A(IB+I)-A(IC+I)))-(SIN36*B(IB+I)-SIN72*B(IC+I)) + C(JD+J)=((A(IA+I)-0.25_JPRB*(A(IB+I)+A(IC+I)))- & + & QRT5*(A(IB+I)-A(IC+I)))+(SIN36*B(IB+I)-SIN72*B(IC+I)) + C(JE+J)=((A(IA+I)-0.25_JPRB*(A(IB+I)+A(IC+I)))+ & + & QRT5*(A(IB+I)-A(IC+I)))+(SIN72*B(IB+I)+SIN36*B(IC+I)) + I=I+INC3 + J=J+INC4 + 510 CONTINUE + IBASE=IBASE+INC1 + JBASE=JBASE+INC21 + 520 CONTINUE + IA=IA+IINK + IINK=2*IINK + IB=IB+IINK + IC=IC+IINK + ID=ID-IINK + IE=IE-IINK + JBASE=JBASE+JUMP + JUMP=2*JUMP+JINK +! + IF (IB.LT.ID) THEN + DO 550 K=LA,KSTOP,LA + KB=K+K + KC=KB+KB + KD=KC+KB + KE=KD+KB + C1=TRIGS(KB+1) + S1=TRIGS(KB+2) + C2=TRIGS(KC+1) + S2=TRIGS(KC+2) + C3=TRIGS(KD+1) + S3=TRIGS(KD+2) + C4=TRIGS(KE+1) + S4=TRIGS(KE+2) + IBASE=0 + DO 540 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 530 IJK=1,ILOT +! + A10=(A(IA+I)-0.25_JPRB*((A(IB+I)+A(IE+I))+(A(IC+I)+A(ID+I)))) & + & +QRT5*((A(IB+I)+A(IE+I))-(A(IC+I)+A(ID+I))) + A20=(A(IA+I)-0.25_JPRB*((A(IB+I)+A(IE+I))+(A(IC+I)+A(ID+I)))) & + & -QRT5*((A(IB+I)+A(IE+I))-(A(IC+I)+A(ID+I))) + B10=(B(IA+I)-0.25_JPRB*((B(IB+I)-B(IE+I))+(B(IC+I)-B(ID+I)))) & + & +QRT5*((B(IB+I)-B(IE+I))-(B(IC+I)-B(ID+I))) + B20=(B(IA+I)-0.25_JPRB*((B(IB+I)-B(IE+I))+(B(IC+I)-B(ID+I)))) & + & -QRT5*((B(IB+I)-B(IE+I))-(B(IC+I)-B(ID+I))) + A11=SIN72*(B(IB+I)+B(IE+I))+SIN36*(B(IC+I)+B(ID+I)) + A21=SIN36*(B(IB+I)+B(IE+I))-SIN72*(B(IC+I)+B(ID+I)) + B11=SIN72*(A(IB+I)-A(IE+I))+SIN36*(A(IC+I)-A(ID+I)) + B21=SIN36*(A(IB+I)-A(IE+I))-SIN72*(A(IC+I)-A(ID+I)) +! + C(JA+J)=A(IA+I)+((A(IB+I)+A(IE+I))+(A(IC+I)+A(ID+I))) + D(JA+J)=B(IA+I)+((B(IB+I)-B(IE+I))+(B(IC+I)-B(ID+I))) + C(JB+J)=C1*(A10-A11)-S1*(B10+B11) + D(JB+J)=S1*(A10-A11)+C1*(B10+B11) + C(JE+J)=C4*(A10+A11)-S4*(B10-B11) + D(JE+J)=S4*(A10+A11)+C4*(B10-B11) + C(JC+J)=C2*(A20-A21)-S2*(B20+B21) + D(JC+J)=S2*(A20-A21)+C2*(B20+B21) + C(JD+J)=C3*(A20+A21)-S3*(B20-B21) + D(JD+J)=S3*(A20+A21)+C3*(B20-B21) +! + I=I+INC3 + J=J+INC4 + 530 CONTINUE + IBASE=IBASE+INC1 + JBASE=JBASE+INC21 + 540 CONTINUE + IA=IA+IINK + IB=IB+IINK + IC=IC+IINK + ID=ID-IINK + IE=IE-IINK + JBASE=JBASE+JUMP + 550 CONTINUE + ENDIF +! + IF (IB.EQ.ID) THEN + IBASE=0 + DO 580 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 570 IJK=1,ILOT + C(JA+J)=(A(IA+I)+A(IB+I))+A(IC+I) + C(JB+J)=(QRT5*(A(IA+I)-A(IB+I))+ & + & (0.25_JPRB*(A(IA+I)+A(IB+I))-A(IC+I))) & + & -(SIN36*B(IA+I)+SIN72*B(IB+I)) + C(JE+J)=-(QRT5*(A(IA+I)-A(IB+I))+ & + & (0.25_JPRB*(A(IA+I)+A(IB+I))-A(IC+I))) & + & -(SIN36*B(IA+I)+SIN72*B(IB+I)) + C(JC+J)=(QRT5*(A(IA+I)-A(IB+I))- & + & (0.25_JPRB*(A(IA+I)+A(IB+I))-A(IC+I))) & + & -(SIN72*B(IA+I)-SIN36*B(IB+I)) + C(JD+J)=-(QRT5*(A(IA+I)-A(IB+I))- & + & (0.25_JPRB*(A(IA+I)+A(IB+I))-A(IC+I))) & + & -(SIN72*B(IA+I)-SIN36*B(IB+I)) + I=I+INC3 + J=J+INC4 + 570 CONTINUE + IBASE=IBASE+INC1 + JBASE=JBASE+INC21 + 580 CONTINUE + ENDIF +! + ELSE !!! Case LA=M + QQRT5=2.0*QRT5 + SSIN36=2.0*SIN36 + SSIN72=2.0*SIN72 + IF (LIPL) THEN + DO 594 L=1,ILA + I=IBASE +!OCL NOVREC +!NEC$ ivdep + DO 592 IJK=1,ILOT + T1=(2.0_JPRB*(A(IA+I)-0.25_JPRB*(A(IB+I)+A(IC+I))) & + & +QQRT5*(A(IB+I)-A(IC+I)))-(SSIN72*B(IB+I)+SSIN36*B(IC+I)) + T2=(2.0_JPRB*(A(IA+I)-0.25_JPRB*(A(IB+I)+A(IC+I))) & + & -QQRT5*(A(IB+I)-A(IC+I)))-(SSIN36*B(IB+I)-SSIN72*B(IC+I)) + T3=(2.0_JPRB*(A(IA+I)-0.25_JPRB*(A(IB+I)+A(IC+I))) & + & -QQRT5*(A(IB+I)-A(IC+I)))+(SSIN36*B(IB+I)-SSIN72*B(IC+I)) + T4=(2.0_JPRB*(A(IA+I)-0.25_JPRB*(A(IB+I)+A(IC+I))) & + & +QQRT5*(A(IB+I)-A(IC+I)))+(SSIN72*B(IB+I)+SSIN36*B(IC+I)) + A(IA+I)=2.0_JPRB*(A(IA+I)+(A(IB+I)+A(IC+I))) + A(IB+I)=T1 + B(IB+I)=T2 + A(IC+I)=T3 + B(IC+I)=T4 + I=I+INC3 + 592 CONTINUE + IBASE=IBASE+INC1 + 594 CONTINUE + ELSE + DO 598 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 596 IJK=1,ILOT + C(JA+J)=2.0_JPRB*(A(IA+I)+(A(IB+I)+A(IC+I))) + C(JB+J)=(2.0_JPRB*(A(IA+I)-0.25_JPRB*(A(IB+I)+A(IC+I))) & + & +QQRT5*(A(IB+I)-A(IC+I)))-(SSIN72*B(IB+I)+SSIN36*B(IC+I)) + C(JC+J)=(2.0_JPRB*(A(IA+I)-0.25_JPRB*(A(IB+I)+A(IC+I))) & + & -QQRT5*(A(IB+I)-A(IC+I)))-(SSIN36*B(IB+I)-SSIN72*B(IC+I)) + C(JD+J)=(2.0_JPRB*(A(IA+I)-0.25_JPRB*(A(IB+I)+A(IC+I))) & + & -QQRT5*(A(IB+I)-A(IC+I)))+(SSIN36*B(IB+I)-SSIN72*B(IC+I)) + C(JE+J)=(2.0_JPRB*(A(IA+I)-0.25_JPRB*(A(IB+I)+A(IC+I))) & + & +QQRT5*(A(IB+I)-A(IC+I)))+(SSIN72*B(IB+I)+SSIN36*B(IC+I)) + I=I+INC3 + J=J+INC4 + 596 CONTINUE + IBASE=IBASE+INC1 + JBASE=JBASE+INC21 + 598 CONTINUE + ENDIF + ENDIF +! + ELSEIF (IFAC.EQ.6) THEN +! +! CODING FOR FACTOR 6 +! ------------------- + 600 CONTINUE + IA=1 + IB=IA+(2*M-LA)*INC1 + IC=IB+2*M*INC1 + ID=IC+2*M*INC1 + IE=IC + IF=IB + JA=1 + JB=JA+JINK + JC=JB+JINK + JD=JC+JINK + JE=JD+JINK + JF=JE+JINK +! + IF (LA.NE.M) THEN +! + DO 620 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 610 IJK=1,ILOT + C(JA+J)=(A(IA+I)+A(ID+I))+(A(IB+I)+A(IC+I)) + C(JD+J)=(A(IA+I)-A(ID+I))-(A(IB+I)-A(IC+I)) + C(JB+J)=((A(IA+I)-A(ID+I))+0.5_JPRB*(A(IB+I)-A(IC+I))) & + & -(SIN60*(B(IB+I)+B(IC+I))) + C(JF+J)=((A(IA+I)-A(ID+I))+0.5_JPRB*(A(IB+I)-A(IC+I))) & + & +(SIN60*(B(IB+I)+B(IC+I))) + C(JC+J)=((A(IA+I)+A(ID+I))-0.5_JPRB*(A(IB+I)+A(IC+I))) & + & -(SIN60*(B(IB+I)-B(IC+I))) + C(JE+J)=((A(IA+I)+A(ID+I))-0.5_JPRB*(A(IB+I)+A(IC+I))) & + & +(SIN60*(B(IB+I)-B(IC+I))) + I=I+INC3 + J=J+INC4 + 610 CONTINUE + IBASE=IBASE+INC1 + JBASE=JBASE+INC21 + 620 CONTINUE + IA=IA+IINK + IINK=2*IINK + IB=IB+IINK + IC=IC+IINK + ID=ID-IINK + IE=IE-IINK + IF=IF-IINK + JBASE=JBASE+JUMP + JUMP=2*JUMP+JINK +! + IF (IC.LT.ID) THEN + DO 650 K=LA,KSTOP,LA + KB=K+K + KC=KB+KB + KD=KC+KB + KE=KD+KB + KF=KE+KB + C1=TRIGS(KB+1) + S1=TRIGS(KB+2) + C2=TRIGS(KC+1) + S2=TRIGS(KC+2) + C3=TRIGS(KD+1) + S3=TRIGS(KD+2) + C4=TRIGS(KE+1) + S4=TRIGS(KE+2) + C5=TRIGS(KF+1) + S5=TRIGS(KF+2) + IBASE=0 + DO 640 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 630 IJK=1,ILOT +! + A11= (A(IE+I)+A(IB+I))+(A(IC+I)+A(IF+I)) + A20=(A(IA+I)+A(ID+I))-0.5_JPRB*A11 + A21=SIN60*((A(IE+I)+A(IB+I))-(A(IC+I)+A(IF+I))) + B11= (B(IB+I)-B(IE+I))+(B(IC+I)-B(IF+I)) + B20=(B(IA+I)-B(ID+I))-0.5_JPRB*B11 + B21=SIN60*((B(IB+I)-B(IE+I))-(B(IC+I)-B(IF+I))) +! + C(JA+J)=(A(IA+I)+A(ID+I))+A11 + D(JA+J)=(B(IA+I)-B(ID+I))+B11 + C(JC+J)=C2*(A20-B21)-S2*(B20+A21) + D(JC+J)=S2*(A20-B21)+C2*(B20+A21) + C(JE+J)=C4*(A20+B21)-S4*(B20-A21) + D(JE+J)=S4*(A20+B21)+C4*(B20-A21) +! + A11=(A(IE+I)-A(IB+I))+(A(IC+I)-A(IF+I)) + B11=(B(IE+I)+B(IB+I))-(B(IC+I)+B(IF+I)) + A20=(A(IA+I)-A(ID+I))-0.5_JPRB*A11 + A21=SIN60*((A(IE+I)-A(IB+I))-(A(IC+I)-A(IF+I))) + B20=(B(IA+I)+B(ID+I))+0.5_JPRB*B11 + B21=SIN60*((B(IE+I)+B(IB+I))+(B(IC+I)+B(IF+I))) +! + C(JD+J)= & + & C3*((A(IA+I)-A(ID+I))+A11)-S3*((B(IA+I)+B(ID+I))-B11) + D(JD+J)= & + & S3*((A(IA+I)-A(ID+I))+A11)+C3*((B(IA+I)+B(ID+I))-B11) + C(JB+J)=C1*(A20-B21)-S1*(B20-A21) + D(JB+J)=S1*(A20-B21)+C1*(B20-A21) + C(JF+J)=C5*(A20+B21)-S5*(B20+A21) + D(JF+J)=S5*(A20+B21)+C5*(B20+A21) +! + I=I+INC3 + J=J+INC4 + 630 CONTINUE + IBASE=IBASE+INC1 + JBASE=JBASE+INC21 + 640 CONTINUE + IA=IA+IINK + IB=IB+IINK + IC=IC+IINK + ID=ID-IINK + IE=IE-IINK + IF=IF-IINK + JBASE=JBASE+JUMP + 650 CONTINUE + ENDIF +! + IF (IC.EQ.ID) THEN + IBASE=0 + DO 680 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 670 IJK=1,ILOT + C(JA+J)=A(IB+I)+(A(IA+I)+A(IC+I)) + C(JD+J)=B(IB+I)-(B(IA+I)+B(IC+I)) + C(JB+J)=(SIN60*(A(IA+I)-A(IC+I)))- & + & (0.5_JPRB*(B(IA+I)+B(IC+I))+B(IB+I)) + C(JF+J)=-(SIN60*(A(IA+I)-A(IC+I)))- & + & (0.5_JPRB*(B(IA+I)+B(IC+I))+B(IB+I)) + C(JC+J)=SIN60*(B(IC+I)-B(IA+I))+ & + & (0.5_JPRB*(A(IA+I)+A(IC+I))-A(IB+I)) + C(JE+J)=SIN60*(B(IC+I)-B(IA+I))- & + & (0.5_JPRB*(A(IA+I)+A(IC+I))-A(IB+I)) + I=I+INC3 + J=J+INC4 + 670 CONTINUE + IBASE=IBASE+INC1 + JBASE=JBASE+INC21 + 680 CONTINUE + ENDIF +! + ELSE !!! Case LA=M + SSIN60=2.0_JPRB*SIN60 + IF (LIPL) THEN + DO 694 L=1,ILA + I=IBASE +!OCL NOVREC +!NEC$ ivdep + DO 692 IJK=1,ILOT + T1=(2.0_JPRB*(A(IA+I)-A(ID+I))+(A(IB+I)-A(IC+I))) & + & -(SSIN60*(B(IB+I)+B(IC+I))) + T5=(2.0_JPRB*(A(IA+I)-A(ID+I))+(A(IB+I)-A(IC+I))) & + & +(SSIN60*(B(IB+I)+B(IC+I))) + T2=(2.0_JPRB*(A(IA+I)+A(ID+I))-(A(IB+I)+A(IC+I))) & + & -(SSIN60*(B(IB+I)-B(IC+I))) + T4=(2.0_JPRB*(A(IA+I)+A(ID+I))-(A(IB+I)+A(IC+I))) & + & +(SSIN60*(B(IB+I)-B(IC+I))) + T3=(2.0_JPRB*(A(IA+I)-A(ID+I)))-(2.0_JPRB*(A(IB+I)-A(IC+I))) + A(IA+I)=(2.0_JPRB*(A(IA+I)+A(ID+I)))+ & + & (2.0_JPRB*(A(IB+I)+A(IC+I))) + A(IB+I)=T1 + B(IB+I)=T2 + A(IC+I)=T3 + B(IC+I)=T4 + A(ID+I)=T5 + I=I+INC3 + 692 CONTINUE + IBASE=IBASE+INC1 + 694 CONTINUE + ELSE + DO 698 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 696 IJK=1,ILOT + C(JA+J)=(2.0_JPRB*(A(IA+I)+A(ID+I)))+ & + & (2.0_JPRB*(A(IB+I)+A(IC+I))) + C(JD+J)=(2.0_JPRB*(A(IA+I)-A(ID+I)))- & + & (2.0_JPRB*(A(IB+I)-A(IC+I))) + C(JB+J)=(2.0_JPRB*(A(IA+I)-A(ID+I))+(A(IB+I)-A(IC+I))) & + & -(SSIN60*(B(IB+I)+B(IC+I))) + C(JF+J)=(2.0_JPRB*(A(IA+I)-A(ID+I))+(A(IB+I)-A(IC+I))) & + & +(SSIN60*(B(IB+I)+B(IC+I))) + C(JC+J)=(2.0_JPRB*(A(IA+I)+A(ID+I))-(A(IB+I)+A(IC+I))) & + & -(SSIN60*(B(IB+I)-B(IC+I))) + C(JE+J)=(2.0_JPRB*(A(IA+I)+A(ID+I))-(A(IB+I)+A(IC+I))) & + & +(SSIN60*(B(IB+I)-B(IC+I))) + I=I+INC3 + J=J+INC4 + 696 CONTINUE + IBASE=IBASE+INC1 + JBASE=JBASE+INC21 + 698 CONTINUE + ENDIF + ENDIF +! + ELSEIF (IFAC.EQ.8) THEN +! +! CODING FOR FACTOR 8 +! ------------------- + 800 CONTINUE + IF (LA.NE.M) THEN + IBAD=3 + ELSE + IA=1 + IB=IA+LA*INC1 + IC=IB+2*LA*INC1 + ID=IC+2*LA*INC1 + IE=ID+2*LA*INC1 + JA=1 + JB=JA+JINK + JC=JB+JINK + JD=JC+JINK + JE=JD+JINK + JF=JE+JINK + JG=JF+JINK + JH=JG+JINK + SSIN45=SQRT(2.0_JPRB) +! + IF (LIPL) THEN + DO 820 L=1,ILA + I=IBASE +!OCL NOVREC +!NEC$ ivdep + DO 810 IJK=1,ILOT + T2=2.0_JPRB*(((A(IA+I)+A(IE+I))-A(IC+I))-(B(IB+I)-B(ID+I))) + T6=2.0_JPRB*(((A(IA+I)+A(IE+I))-A(IC+I))+(B(IB+I)-B(ID+I))) + T1=2.0_JPRB*((A(IA+I)-A(IE+I))-B(IC+I)) & + & +SSIN45*((A(IB+I)-A(ID+I))-(B(IB+I)+B(ID+I))) + T5=2.0_JPRB*((A(IA+I)-A(IE+I))-B(IC+I)) & + & -SSIN45*((A(IB+I)-A(ID+I))-(B(IB+I)+B(ID+I))) + T3=2.0_JPRB*((A(IA+I)-A(IE+I))+B(IC+I)) & + & -SSIN45*((A(IB+I)-A(ID+I))+(B(IB+I)+B(ID+I))) + T7=2.0_JPRB*((A(IA+I)-A(IE+I))+B(IC+I)) & + & +SSIN45*((A(IB+I)-A(ID+I))+(B(IB+I)+B(ID+I))) + T4=2.0_JPRB*(((A(IA+I)+A(IE+I))+A(IC+I))-(A(IB+I)+A(ID+I))) + A(IA+I)=2.0_JPRB*(((A(IA+I)+A(IE+I))+A(IC+I))+(A(IB+I)+A(ID+I))) + A(IB+I)=T1 + B(IB+I)=T2 + A(IC+I)=T3 + B(IC+I)=T4 + A(ID+I)=T5 + B(ID+I)=T6 + A(IE+I)=T7 + I=I+INC3 + 810 CONTINUE + IBASE=IBASE+INC1 + 820 CONTINUE + ELSE + DO 840 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 830 IJK=1,ILOT + C(JA+J)=2.0_JPRB*(((A(IA+I)+A(IE+I))+A(IC+I))+(A(IB+I)+A(ID+I))) + C(JE+J)=2.0_JPRB*(((A(IA+I)+A(IE+I))+A(IC+I))-(A(IB+I)+A(ID+I))) + C(JC+J)=2.0_JPRB*(((A(IA+I)+A(IE+I))-A(IC+I))-(B(IB+I)-B(ID+I))) + C(JG+J)=2.0_JPRB*(((A(IA+I)+A(IE+I))-A(IC+I))+(B(IB+I)-B(ID+I))) + C(JB+J)=2.0_JPRB*((A(IA+I)-A(IE+I))-B(IC+I)) & + & +SSIN45*((A(IB+I)-A(ID+I))-(B(IB+I)+B(ID+I))) + C(JF+J)=2.0_JPRB*((A(IA+I)-A(IE+I))-B(IC+I)) & + & -SSIN45*((A(IB+I)-A(ID+I))-(B(IB+I)+B(ID+I))) + C(JD+J)=2.0_JPRB*((A(IA+I)-A(IE+I))+B(IC+I)) & + & -SSIN45*((A(IB+I)-A(ID+I))+(B(IB+I)+B(ID+I))) + C(JH+J)=2.0_JPRB*((A(IA+I)-A(IE+I))+B(IC+I)) & + & +SSIN45*((A(IB+I)-A(ID+I))+(B(IB+I)+B(ID+I))) + I=I+INC3 + J=J+INC4 + 830 CONTINUE + IBASE=IBASE+INC1 + JBASE=JBASE+INC21 + 840 CONTINUE + ENDIF +! + ENDIF +! + ELSE +! + IBAD=2 !!! Illegal factor +! + ENDIF +! +! RETURN +! ------ + 900 CONTINUE + IERR=IBAD + ENDSUBROUTINE RPASSF + +! SUBROUTINE 'QPASSF' - PERFORMS ONE PASS THROUGH DATA AS PART +! OF MULTIPLE REAL FFT (FOURIER ANALYSIS) ROUTINE +! +! A IS FIRST REAL INPUT VECTOR +! EQUIVALENCE B(1) WITH A(IFAC*LA*INC1+1) +! C IS FIRST REAL OUTPUT VECTOR +! EQUIVALENCE D(1) WITH C(LA*INC2+1) +! TRIGS IS A PRECALCULATED LIST OF SINES & COSINES +! INC1 IS THE ADDRESSING INCREMENT FOR A +! INC2 IS THE ADDRESSING INCREMENT FOR C +! INC3 IS THE INCREMENT BETWEEN INPUT VECTORS A +! INC4 IS THE INCREMENT BETWEEN OUTPUT VECTORS C +! LOT IS THE NUMBER OF VECTORS +! N IS THE LENGTH OF THE VECTORS +! IFAC IS THE CURRENT FACTOR OF N +! LA = N/(PRODUCT OF FACTORS USED SO FAR) +! IERR IS AN ERROR INDICATOR: +! 0 - PASS COMPLETED WITHOUT ERROR +! 1 - LOT GREATER THAN 64 +! 2 - IFAC NOT CATERED FOR +! 3 - IFAC ONLY CATERED FOR IF LA=N/IFAC +! LIPL=.T. => RESULTS ARE RETURNED TO INPUT ARRAY +! (ONLY VALID IF LA=N/IFAC, I.E. ON FIRST PASS) +! +!----------------------------------------------------------------------- +! + SUBROUTINE QPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & + & LA,IERR,LIPL) +!AUTOPROMOTE + USE PARKIND1, ONLY : JPIM, JPRB + USE YOMHOOK , ONLY : DR_HOOK, JPHOOK +! + IMPLICIT NONE +! + INTEGER(KIND=JPIM) :: N + REAL(KIND=JPRB) :: A(*) + REAL(KIND=JPRB) :: B(*) + REAL(KIND=JPRB) :: C(*) + REAL(KIND=JPRB) :: D(*) + REAL(KIND=JPRB) :: TRIGS(N) + REAL(KIND=JPRB) :: A0,A1,A2,A3,A4,A5,A6,A10,A11,A20,A21 + REAL(KIND=JPRB) :: B0,B1,B2,B3,B4,B5,B6,B10,B11,B20,B21 + REAL(KIND=JPRB) :: C1,C2,C3,C4,C5 + REAL(KIND=JPRB) :: S1,S2,S3,S4,S5 + REAL(KIND=JPRB) :: T1,T2,T3,T4,T5,T6,T7 + REAL(KIND=JPRB) :: Z + REAL(KIND=JPRB) :: QRT5,SIN36,SIN45,SIN60,SIN72 + REAL(KIND=JPRB) :: ZQRT5,ZSIN36,ZSIN45,ZSIN60,ZSIN72 + INTEGER(KIND=JPIM) :: IERR + INTEGER(KIND=JPIM) :: INC1 + INTEGER(KIND=JPIM) :: INC2 + INTEGER(KIND=JPIM) :: INC3 + INTEGER(KIND=JPIM) :: INC4 + INTEGER(KIND=JPIM) :: LOT + INTEGER(KIND=JPIM) :: IFAC + INTEGER(KIND=JPIM) :: LA + INTEGER(KIND=JPIM) :: IINK,IJK,ILOT + INTEGER(KIND=JPIM) :: I,IA,IB,IBAD,IBASE,IC,ID,IE,IF,IG,IH + INTEGER(KIND=JPIM) :: IJUMP,ILA,INC11 + INTEGER(KIND=JPIM) :: J,JA,JB,JC,JD,JE,JBASE,JF,JINK + INTEGER(KIND=JPIM) :: K,KB,KC,KD,KE,KF,KSTOP + INTEGER(KIND=JPIM) :: L,M + LOGICAL :: LIPL +! + DATA SIN36/0.587785252292473_JPRB/,SIN72/0.951056516295154_JPRB/, & + & QRT5/0.559016994374947_JPRB/,SIN60/0.866025403784437_JPRB/ +! + M=N/IFAC + IINK=LA*INC1 + JINK=LA*INC2 + IJUMP=(IFAC-1)*IINK + KSTOP=(N-IFAC)/(2*IFAC) +! + IBASE=0 + JBASE=0 + IBAD=0 +! +! Increase the vector length by fusing the loops if the +! data layout is appropriate: + IF (INC1.EQ.LOT.AND.INC2.EQ.LOT.AND.INC3.EQ.1.AND.INC4.EQ.1) THEN + ILA=1 + ILOT=LA*LOT + INC11=LA*LOT + ELSE + ILA=LA + ILOT=LOT + INC11=INC1 + ENDIF + +! + IF (IFAC.EQ.2) THEN +! +! CODING FOR FACTOR 2 +! ------------------- + 200 CONTINUE + IA=1 + IB=IA+IINK + JA=1 + JB=JA+(2*M-LA)*INC2 +! + IF (LA.NE.M) THEN +! + DO 220 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 210 IJK=1,ILOT + C(JA+J)=A(IA+I)+A(IB+I) + C(JB+J)=A(IA+I)-A(IB+I) + I=I+INC3 + J=J+INC4 + 210 CONTINUE + IBASE=IBASE+INC11 + JBASE=JBASE+INC2 + 220 CONTINUE + JA=JA+JINK + JINK=2*JINK + JB=JB-JINK + IBASE=IBASE+IJUMP + IJUMP=2*IJUMP+IINK +! + IF (JA.LT.JB) THEN + DO 250 K=LA,KSTOP,LA + KB=K+K + C1=TRIGS(KB+1) + S1=TRIGS(KB+2) + JBASE=0 + DO 240 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 230 IJK=1,ILOT + C(JA+J)=A(IA+I)+(C1*A(IB+I)+S1*B(IB+I)) + C(JB+J)=A(IA+I)-(C1*A(IB+I)+S1*B(IB+I)) + D(JA+J)=(C1*B(IB+I)-S1*A(IB+I))+B(IA+I) + D(JB+J)=(C1*B(IB+I)-S1*A(IB+I))-B(IA+I) + I=I+INC3 + J=J+INC4 + 230 CONTINUE + IBASE=IBASE+INC11 + JBASE=JBASE+INC2 + 240 CONTINUE + IBASE=IBASE+IJUMP + JA=JA+JINK + JB=JB-JINK + 250 CONTINUE + ENDIF +! + IF (JA.EQ.JB) THEN + JBASE=0 + DO 280 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 270 IJK=1,ILOT + C(JA+J)=A(IA+I) + D(JA+J)=-A(IB+I) + I=I+INC3 + J=J+INC4 + 270 CONTINUE + IBASE=IBASE+INC11 + JBASE=JBASE+INC2 + 280 CONTINUE + ENDIF +! + ELSE !!! Case LA=M + Z=1.0_JPRB/REAL(N,KIND=JPRB) + IF (LIPL) THEN + DO 294 L=1,ILA + I=IBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 292 IJK=1,ILOT + T1=Z*(A(IA+I)-A(IB+I)) + A(IA+I)=Z*(A(IA+I)+A(IB+I)) + A(IB+I)=T1 + I=I+INC3 + 292 CONTINUE + IBASE=IBASE+INC11 + 294 CONTINUE + ELSE + DO 298 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 296 IJK=1,ILOT + C(JA+J)=Z*(A(IA+I)+A(IB+I)) + C(JB+J)=Z*(A(IA+I)-A(IB+I)) + I=I+INC3 + J=J+INC4 + 296 CONTINUE + IBASE=IBASE+INC11 + JBASE=JBASE+INC2 + 298 CONTINUE + ENDIF + ENDIF +! + ELSEIF (IFAC.EQ.3) THEN +! +! CODING FOR FACTOR 3 +! ------------------- + 300 CONTINUE + IA=1 + IB=IA+IINK + IC=IB+IINK + JA=1 + JB=JA+(2*M-LA)*INC2 + JC=JB +! + IF (LA.NE.M) THEN +! + DO 320 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 310 IJK=1,ILOT + C(JA+J)=A(IA+I)+(A(IB+I)+A(IC+I)) + C(JB+J)=A(IA+I)-0.5_JPRB*(A(IB+I)+A(IC+I)) + D(JB+J)=SIN60*(A(IC+I)-A(IB+I)) + I=I+INC3 + J=J+INC4 + 310 CONTINUE + IBASE=IBASE+INC11 + JBASE=JBASE+INC2 + 320 CONTINUE + JA=JA+JINK + JINK=2*JINK + JB=JB+JINK + JC=JC-JINK + IBASE=IBASE+IJUMP + IJUMP=2*IJUMP+IINK +! + IF (JA.LT.JC) THEN + DO 350 K=LA,KSTOP,LA + KB=K+K + KC=KB+KB + C1=TRIGS(KB+1) + S1=TRIGS(KB+2) + C2=TRIGS(KC+1) + S2=TRIGS(KC+2) + JBASE=0 + DO 340 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 330 IJK=1,ILOT + A1=(C1*A(IB+I)+S1*B(IB+I))+(C2*A(IC+I)+S2*B(IC+I)) + B1=(C1*B(IB+I)-S1*A(IB+I))+(C2*B(IC+I)-S2*A(IC+I)) + A2=A(IA+I)-0.5_JPRB*A1 + B2=B(IA+I)-0.5_JPRB*B1 + A3=SIN60*((C1*A(IB+I)+S1*B(IB+I))-(C2*A(IC+I)+S2*B(IC+I))) + B3=SIN60*((C1*B(IB+I)-S1*A(IB+I))-(C2*B(IC+I)-S2*A(IC+I))) + C(JA+J)=A(IA+I)+A1 + D(JA+J)=B(IA+I)+B1 + C(JB+J)=A2+B3 + D(JB+J)=B2-A3 + C(JC+J)=A2-B3 + D(JC+J)=-(B2+A3) + I=I+INC3 + J=J+INC4 + 330 CONTINUE + IBASE=IBASE+INC11 + JBASE=JBASE+INC2 + 340 CONTINUE + IBASE=IBASE+IJUMP + JA=JA+JINK + JB=JB+JINK + JC=JC-JINK + 350 CONTINUE + ENDIF +! + IF (JA.EQ.JC) THEN + JBASE=0 + DO 380 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 370 IJK=1,ILOT + C(JA+J)=A(IA+I)+0.5_JPRB*(A(IB+I)-A(IC+I)) + D(JA+J)=-SIN60*(A(IB+I)+A(IC+I)) + C(JB+J)=A(IA+I)-(A(IB+I)-A(IC+I)) + I=I+INC3 + J=J+INC4 + 370 CONTINUE + IBASE=IBASE+INC11 + JBASE=JBASE+INC2 + 380 CONTINUE + ENDIF +! + ELSE !!! Case LA=M + Z=1.0_JPRB/REAL(N,KIND=JPRB) + ZSIN60=Z*SIN60 + IF (LIPL) THEN + DO 394 L=1,ILA + I=IBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 392 IJK=1,ILOT + T1=Z*(A(IA+I)-0.5_JPRB*(A(IB+I)+A(IC+I))) + T2=ZSIN60*(A(IC+I)-A(IB+I)) + A(IA+I)=Z*(A(IA+I)+(A(IB+I)+A(IC+I))) + A(IB+I)=T1 + A(IC+I)=T2 + I=I+INC3 + 392 CONTINUE + IBASE=IBASE+INC11 + 394 CONTINUE + ELSE + DO 398 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 396 IJK=1,ILOT + C(JA+J)=Z*(A(IA+I)+(A(IB+I)+A(IC+I))) + C(JB+J)=Z*(A(IA+I)-0.5_JPRB*(A(IB+I)+A(IC+I))) + D(JB+J)=ZSIN60*(A(IC+I)-A(IB+I)) + I=I+INC3 + J=J+INC4 + 396 CONTINUE + IBASE=IBASE+INC11 + JBASE=JBASE+INC2 + 398 CONTINUE + ENDIF + ENDIF +! + ELSEIF (IFAC.EQ.4) THEN +! +! CODING FOR FACTOR 4 +! ------------------- + 400 CONTINUE + IA=1 + IB=IA+IINK + IC=IB+IINK + ID=IC+IINK + JA=1 + JB=JA+(2*M-LA)*INC2 + JC=JB+2*M*INC2 + JD=JB +! + IF (LA.NE.M) THEN +! + DO 420 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 410 IJK=1,ILOT + C(JA+J)=(A(IA+I)+A(IC+I))+(A(IB+I)+A(ID+I)) + C(JC+J)=(A(IA+I)+A(IC+I))-(A(IB+I)+A(ID+I)) + C(JB+J)=A(IA+I)-A(IC+I) + D(JB+J)=A(ID+I)-A(IB+I) + I=I+INC3 + J=J+INC4 + 410 CONTINUE + IBASE=IBASE+INC11 + JBASE=JBASE+INC2 + 420 CONTINUE + JA=JA+JINK + JINK=2*JINK + JB=JB+JINK + JC=JC-JINK + JD=JD-JINK + IBASE=IBASE+IJUMP + IJUMP=2*IJUMP+IINK +! + IF (JB.LT.JC) THEN + DO 450 K=LA,KSTOP,LA + KB=K+K + KC=KB+KB + KD=KC+KB + C1=TRIGS(KB+1) + S1=TRIGS(KB+2) + C2=TRIGS(KC+1) + S2=TRIGS(KC+2) + C3=TRIGS(KD+1) + S3=TRIGS(KD+2) + JBASE=0 + DO 440 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 430 IJK=1,ILOT + A0=A(IA+I)+(C2*A(IC+I)+S2*B(IC+I)) + A2=A(IA+I)-(C2*A(IC+I)+S2*B(IC+I)) + A1=(C1*A(IB+I)+S1*B(IB+I))+(C3*A(ID+I)+S3*B(ID+I)) + A3=(C1*A(IB+I)+S1*B(IB+I))-(C3*A(ID+I)+S3*B(ID+I)) + B0=B(IA+I)+(C2*B(IC+I)-S2*A(IC+I)) + B2=B(IA+I)-(C2*B(IC+I)-S2*A(IC+I)) + B1=(C1*B(IB+I)-S1*A(IB+I))+(C3*B(ID+I)-S3*A(ID+I)) + B3=(C1*B(IB+I)-S1*A(IB+I))-(C3*B(ID+I)-S3*A(ID+I)) + C(JA+J)=A0+A1 + C(JC+J)=A0-A1 + D(JA+J)=B0+B1 + D(JC+J)=B1-B0 + C(JB+J)=A2+B3 + C(JD+J)=A2-B3 + D(JB+J)=B2-A3 + D(JD+J)=-(B2+A3) + I=I+INC3 + J=J+INC4 + 430 CONTINUE + IBASE=IBASE+INC11 + JBASE=JBASE+INC2 + 440 CONTINUE + IBASE=IBASE+IJUMP + JA=JA+JINK + JB=JB+JINK + JC=JC-JINK + JD=JD-JINK + 450 CONTINUE + ENDIF +! + IF (JB.EQ.JC) THEN + SIN45=SQRT(0.5_JPRB) + JBASE=0 + DO 480 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 470 IJK=1,ILOT + C(JA+J)=A(IA+I)+SIN45*(A(IB+I)-A(ID+I)) + C(JB+J)=A(IA+I)-SIN45*(A(IB+I)-A(ID+I)) + D(JA+J)=-A(IC+I)-SIN45*(A(IB+I)+A(ID+I)) + D(JB+J)=A(IC+I)-SIN45*(A(IB+I)+A(ID+I)) + I=I+INC3 + J=J+INC4 + 470 CONTINUE + IBASE=IBASE+INC11 + JBASE=JBASE+INC2 + 480 CONTINUE + ENDIF +! + ELSE !!! Case LA=M + Z=1.0_JPRB/REAL(N,KIND=JPRB) + IF (LIPL) THEN + DO 494 L=1,ILA + I=IBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 492 IJK=1,ILOT + T1=Z*(A(IA+I)-A(IC+I)) + T3=Z*(A(ID+I)-A(IB+I)) + T2=Z*((A(IA+I)+A(IC+I))-(A(IB+I)+A(ID+I))) + A(IA+I)=Z*((A(IA+I)+A(IC+I))+(A(IB+I)+A(ID+I))) + A(IB+I)=T1 + A(IC+I)=T2 + A(ID+I)=T3 + I=I+INC3 + 492 CONTINUE + IBASE=IBASE+INC11 + 494 CONTINUE + ELSE + DO 498 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 496 IJK=1,ILOT + C(JA+J)=Z*((A(IA+I)+A(IC+I))+(A(IB+I)+A(ID+I))) + C(JC+J)=Z*((A(IA+I)+A(IC+I))-(A(IB+I)+A(ID+I))) + C(JB+J)=Z*(A(IA+I)-A(IC+I)) + D(JB+J)=Z*(A(ID+I)-A(IB+I)) + I=I+INC3 + J=J+INC4 + 496 CONTINUE + IBASE=IBASE+INC11 + JBASE=JBASE+INC2 + 498 CONTINUE + ENDIF + ENDIF +! + ELSEIF (IFAC.EQ.5) THEN +! +! CODING FOR FACTOR 5 +! ------------------- + 500 CONTINUE + IA=1 + IB=IA+IINK + IC=IB+IINK + ID=IC+IINK + IE=ID+IINK + JA=1 + JB=JA+(2*M-LA)*INC2 + JC=JB+2*M*INC2 + JD=JC + JE=JB +! + IF (LA.NE.M) THEN +! + DO 520 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 510 IJK=1,ILOT + A1=A(IB+I)+A(IE+I) + A3=A(IB+I)-A(IE+I) + A2=A(IC+I)+A(ID+I) + A4=A(IC+I)-A(ID+I) + A5=A(IA+I)-0.25_JPRB*(A1+A2) + A6=QRT5*(A1-A2) + C(JA+J)=A(IA+I)+(A1+A2) + C(JB+J)=A5+A6 + C(JC+J)=A5-A6 + D(JB+J)=-SIN72*A3-SIN36*A4 + D(JC+J)=-SIN36*A3+SIN72*A4 + I=I+INC3 + J=J+INC4 + 510 CONTINUE + IBASE=IBASE+INC11 + JBASE=JBASE+INC2 + 520 CONTINUE + JA=JA+JINK + JINK=2*JINK + JB=JB+JINK + JC=JC+JINK + JD=JD-JINK + JE=JE-JINK + IBASE=IBASE+IJUMP + IJUMP=2*IJUMP+IINK +! + IF (JB.LT.JD) THEN + DO 550 K=LA,KSTOP,LA + KB=K+K + KC=KB+KB + KD=KC+KB + KE=KD+KB + C1=TRIGS(KB+1) + S1=TRIGS(KB+2) + C2=TRIGS(KC+1) + S2=TRIGS(KC+2) + C3=TRIGS(KD+1) + S3=TRIGS(KD+2) + C4=TRIGS(KE+1) + S4=TRIGS(KE+2) + JBASE=0 + DO 540 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 530 IJK=1,ILOT + A1=(C1*A(IB+I)+S1*B(IB+I))+(C4*A(IE+I)+S4*B(IE+I)) + A3=(C1*A(IB+I)+S1*B(IB+I))-(C4*A(IE+I)+S4*B(IE+I)) + A2=(C2*A(IC+I)+S2*B(IC+I))+(C3*A(ID+I)+S3*B(ID+I)) + A4=(C2*A(IC+I)+S2*B(IC+I))-(C3*A(ID+I)+S3*B(ID+I)) + B1=(C1*B(IB+I)-S1*A(IB+I))+(C4*B(IE+I)-S4*A(IE+I)) + B3=(C1*B(IB+I)-S1*A(IB+I))-(C4*B(IE+I)-S4*A(IE+I)) + B2=(C2*B(IC+I)-S2*A(IC+I))+(C3*B(ID+I)-S3*A(ID+I)) + B4=(C2*B(IC+I)-S2*A(IC+I))-(C3*B(ID+I)-S3*A(ID+I)) + A5=A(IA+I)-0.25_JPRB*(A1+A2) + A6=QRT5*(A1-A2) + B5=B(IA+I)-0.25_JPRB*(B1+B2) + B6=QRT5*(B1-B2) + A10=A5+A6 + A20=A5-A6 + B10=B5+B6 + B20=B5-B6 + A11=SIN72*B3+SIN36*B4 + A21=SIN36*B3-SIN72*B4 + B11=SIN72*A3+SIN36*A4 + B21=SIN36*A3-SIN72*A4 + C(JA+J)=A(IA+I)+(A1+A2) + C(JB+J)=A10+A11 + C(JE+J)=A10-A11 + C(JC+J)=A20+A21 + C(JD+J)=A20-A21 + D(JA+J)=B(IA+I)+(B1+B2) + D(JB+J)=B10-B11 + D(JE+J)=-(B10+B11) + D(JC+J)=B20-B21 + D(JD+J)=-(B20+B21) + I=I+INC3 + J=J+INC4 + 530 CONTINUE + IBASE=IBASE+INC11 + JBASE=JBASE+INC2 + 540 CONTINUE + IBASE=IBASE+IJUMP + JA=JA+JINK + JB=JB+JINK + JC=JC+JINK + JD=JD-JINK + JE=JE-JINK + 550 CONTINUE + ENDIF +! + IF (JB.EQ.JD) THEN + JBASE=0 + DO 580 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 570 IJK=1,ILOT + A1=A(IB+I)+A(IE+I) + A3=A(IB+I)-A(IE+I) + A2=A(IC+I)+A(ID+I) + A4=A(IC+I)-A(ID+I) + A5=A(IA+I)+0.25_JPRB*(A3-A4) + A6=QRT5*(A3+A4) + C(JA+J)=A5+A6 + C(JB+J)=A5-A6 + C(JC+J)=A(IA+I)-(A3-A4) + D(JA+J)=-SIN36*A1-SIN72*A2 + D(JB+J)=-SIN72*A1+SIN36*A2 + I=I+INC3 + J=J+INC4 + 570 CONTINUE + IBASE=IBASE+INC11 + JBASE=JBASE+INC2 + 580 CONTINUE + ENDIF +! + ELSE !!! Case LA=M + Z=1.0_JPRB/REAL(N,KIND=JPRB) + ZQRT5=Z*QRT5 + ZSIN36=Z*SIN36 + ZSIN72=Z*SIN72 + IF (LIPL) THEN + DO 594 L=1,ILA + I=IBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 592 IJK=1,ILOT + A1=A(IB+I)+A(IE+I) + A3=A(IB+I)-A(IE+I) + A2=A(IC+I)+A(ID+I) + A4=A(IC+I)-A(ID+I) + A5=Z*(A(IA+I)-0.25_JPRB*(A1+A2)) + A6=ZQRT5*(A1-A2) + A(IA+I)=Z*(A(IA+I)+(A1+A2)) + A(IB+I)=A5+A6 + A(ID+I)=A5-A6 + A(IC+I)=-ZSIN72*A3-ZSIN36*A4 + A(IE+I)=-ZSIN36*A3+ZSIN72*A4 + I=I+INC3 + 592 CONTINUE + IBASE=IBASE+INC11 + 594 CONTINUE + ELSE + DO 598 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 596 IJK=1,ILOT + A1=A(IB+I)+A(IE+I) + A3=A(IB+I)-A(IE+I) + A2=A(IC+I)+A(ID+I) + A4=A(IC+I)-A(ID+I) + A5=Z*(A(IA+I)-0.25_JPRB*(A1+A2)) + A6=ZQRT5*(A1-A2) + C(JA+J)=Z*(A(IA+I)+(A1+A2)) + C(JB+J)=A5+A6 + C(JC+J)=A5-A6 + D(JB+J)=-ZSIN72*A3-ZSIN36*A4 + D(JC+J)=-ZSIN36*A3+ZSIN72*A4 + I=I+INC3 + J=J+INC4 + 596 CONTINUE + IBASE=IBASE+INC11 + JBASE=JBASE+INC2 + 598 CONTINUE + ENDIF + ENDIF +! + ELSEIF (IFAC.EQ.6) THEN +! +! CODING FOR FACTOR 6 +! ------------------- + 600 CONTINUE + IA=1 + IB=IA+IINK + IC=IB+IINK + ID=IC+IINK + IE=ID+IINK + IF=IE+IINK + JA=1 + JB=JA+(2*M-LA)*INC2 + JC=JB+2*M*INC2 + JD=JC+2*M*INC2 + JE=JC + JF=JB +! + IF (LA.NE.M) THEN +! + DO 620 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 610 IJK=1,ILOT + A11=(A(IC+I)+A(IF+I))+(A(IB+I)+A(IE+I)) + C(JA+J)=(A(IA+I)+A(ID+I))+A11 + C(JC+J)=(A(IA+I)+A(ID+I)-0.5_JPRB*A11) + D(JC+J)=SIN60*((A(IC+I)+A(IF+I))-(A(IB+I)+A(IE+I))) + A11=(A(IC+I)-A(IF+I))+(A(IE+I)-A(IB+I)) + C(JB+J)=(A(IA+I)-A(ID+I))-0.5_JPRB*A11 + D(JB+J)=SIN60*((A(IE+I)-A(IB+I))-(A(IC+I)-A(IF+I))) + C(JD+J)=(A(IA+I)-A(ID+I))+A11 + I=I+INC3 + J=J+INC4 + 610 CONTINUE + IBASE=IBASE+INC11 + JBASE=JBASE+INC2 + 620 CONTINUE + JA=JA+JINK + JINK=2*JINK + JB=JB+JINK + JC=JC+JINK + JD=JD-JINK + JE=JE-JINK + JF=JF-JINK + IBASE=IBASE+IJUMP + IJUMP=2*IJUMP+IINK +! + IF (JC.LT.JD) THEN + DO 650 K=LA,KSTOP,LA + KB=K+K + KC=KB+KB + KD=KC+KB + KE=KD+KB + KF=KE+KB + C1=TRIGS(KB+1) + S1=TRIGS(KB+2) + C2=TRIGS(KC+1) + S2=TRIGS(KC+2) + C3=TRIGS(KD+1) + S3=TRIGS(KD+2) + C4=TRIGS(KE+1) + S4=TRIGS(KE+2) + C5=TRIGS(KF+1) + S5=TRIGS(KF+2) + JBASE=0 + DO 640 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 630 IJK=1,ILOT + A1=C1*A(IB+I)+S1*B(IB+I) + B1=C1*B(IB+I)-S1*A(IB+I) + A2=C2*A(IC+I)+S2*B(IC+I) + B2=C2*B(IC+I)-S2*A(IC+I) + A3=C3*A(ID+I)+S3*B(ID+I) + B3=C3*B(ID+I)-S3*A(ID+I) + A4=C4*A(IE+I)+S4*B(IE+I) + B4=C4*B(IE+I)-S4*A(IE+I) + A5=C5*A(IF+I)+S5*B(IF+I) + B5=C5*B(IF+I)-S5*A(IF+I) + A11=(A2+A5)+(A1+A4) + A20=(A(IA+I)+A3)-0.5_JPRB*A11 + A21=SIN60*((A2+A5)-(A1+A4)) + B11=(B2+B5)+(B1+B4) + B20=(B(IA+I)+B3)-0.5_JPRB*B11 + B21=SIN60*((B2+B5)-(B1+B4)) + C(JA+J)=(A(IA+I)+A3)+A11 + D(JA+J)=(B(IA+I)+B3)+B11 + C(JC+J)=A20-B21 + D(JC+J)=A21+B20 + C(JE+J)=A20+B21 + D(JE+J)=A21-B20 + A11=(A2-A5)+(A4-A1) + A20=(A(IA+I)-A3)-0.5_JPRB*A11 + A21=SIN60*((A4-A1)-(A2-A5)) + B11=(B5-B2)-(B4-B1) + B20=(B3-B(IA+I))-0.5_JPRB*B11 + B21=SIN60*((B5-B2)+(B4-B1)) + C(JB+J)=A20-B21 + D(JB+J)=A21-B20 + C(JD+J)=A11+(A(IA+I)-A3) + D(JD+J)=B11+(B3-B(IA+I)) + C(JF+J)=A20+B21 + D(JF+J)=A21+B20 + I=I+INC3 + J=J+INC4 + 630 CONTINUE + IBASE=IBASE+INC11 + JBASE=JBASE+INC2 + 640 CONTINUE + IBASE=IBASE+IJUMP + JA=JA+JINK + JB=JB+JINK + JC=JC+JINK + JD=JD-JINK + JE=JE-JINK + JF=JF-JINK + 650 CONTINUE + ENDIF +! + IF (JC.EQ.JD) THEN + JBASE=0 + DO 680 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 670 IJK=1,ILOT + C(JA+J)=(A(IA+I)+0.5_JPRB*(A(IC+I)-A(IE+I)))+ & + & SIN60*(A(IB+I)-A(IF+I)) + D(JA+J)=-(A(ID+I)+0.5_JPRB*(A(IB+I)+A(IF+I)))- & + & SIN60*(A(IC+I)+A(IE+I)) + C(JB+J)=A(IA+I)-(A(IC+I)-A(IE+I)) + D(JB+J)=A(ID+I)-(A(IB+I)+A(IF+I)) + C(JC+J)=(A(IA+I)+0.5_JPRB*(A(IC+I)-A(IE+I)))- & + & SIN60*(A(IB+I)-A(IF+I)) + D(JC+J)=-(A(ID+I)+0.5_JPRB*(A(IB+I)+ & + & A(IF+I)))+SIN60*(A(IC+I)+A(IE+I)) + I=I+INC3 + J=J+INC4 + 670 CONTINUE + IBASE=IBASE+INC11 + JBASE=JBASE+INC2 + 680 CONTINUE + ENDIF +! + ELSE !!! Case LA=M + Z=1.0_JPRB/REAL(N,KIND=JPRB) + ZSIN60=Z*SIN60 + IF (LIPL) THEN + DO 694 L=1,ILA + I=IBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 692 IJK=1,ILOT + A11=(A(IC+I)-A(IF+I))+(A(IE+I)-A(IB+I)) + T1=Z*((A(IA+I)-A(ID+I))-0.5_JPRB*A11) + T5=Z*((A(IA+I)-A(ID+I))+A11) + T2=ZSIN60*((A(IE+I)-A(IB+I))-(A(IC+I)-A(IF+I))) + T4=ZSIN60*((A(IC+I)+A(IF+I))-(A(IB+I)+A(IE+I))) + A11=(A(IC+I)+A(IF+I))+(A(IB+I)+A(IE+I)) + T3=Z*((A(IA+I)+A(ID+I))-0.5_JPRB*A11) + A(IA+I)=Z*((A(IA+I)+A(ID+I))+A11) + A(IB+I)=T1 + A(IC+I)=T2 + A(ID+I)=T3 + A(IE+I)=T4 + A(IF+I)=T5 + I=I+INC3 + 692 CONTINUE + IBASE=IBASE+INC11 + 694 CONTINUE + ELSE + DO 698 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 696 IJK=1,ILOT + A11=(A(IC+I)+A(IF+I))+(A(IB+I)+A(IE+I)) + C(JA+J)=Z*((A(IA+I)+A(ID+I))+A11) + C(JC+J)=Z*((A(IA+I)+A(ID+I))-0.5_JPRB*A11) + D(JC+J)=ZSIN60*((A(IC+I)+A(IF+I))-(A(IB+I)+A(IE+I))) + A11=(A(IC+I)-A(IF+I))+(A(IE+I)-A(IB+I)) + C(JB+J)=Z*((A(IA+I)-A(ID+I))-0.5_JPRB*A11) + D(JB+J)=ZSIN60*((A(IE+I)-A(IB+I))-(A(IC+I)-A(IF+I))) + C(JD+J)=Z*((A(IA+I)-A(ID+I))+A11) + I=I+INC3 + J=J+INC4 + 696 CONTINUE + IBASE=IBASE+INC11 + JBASE=JBASE+INC2 + 698 CONTINUE + ENDIF + ENDIF +! + ELSEIF (IFAC.EQ.8) THEN +! +! CODING FOR FACTOR 8 +! ------------------- + 800 CONTINUE + IF (LA.NE.M) THEN + IBAD=3 + ELSE + IA=1 + IB=IA+IINK + IC=IB+IINK + ID=IC+IINK + IE=ID+IINK + IF=IE+IINK + IG=IF+IINK + IH=IG+IINK + JA=1 + JB=JA+LA*INC2 + JC=JB+2*M*INC2 + JD=JC+2*M*INC2 + JE=JD+2*M*INC2 + Z=1.0_JPRB/REAL(N,KIND=JPRB) + ZSIN45=Z*SQRT(0.5_JPRB) +! + IF (LIPL) THEN + DO 820 L=1,ILA + I=IBASE +!OCL NOVREC +!DEC$ IVDEP +!NEC$ ivdep + DO 810 IJK=1,ILOT + T3=Z*((A(IA+I)+A(IE+I))-(A(IC+I)+A(IG+I))) + T4=Z*((A(ID+I)+A(IH+I))-(A(IB+I)+A(IF+I))) + T1=Z*(A(IA+I)-A(IE+I)) & + & +ZSIN45*((A(IH+I)-A(ID+I))-(A(IF+I)-A(IB+I))) + T5=Z*(A(IA+I)-A(IE+I)) & + & -ZSIN45*((A(IH+I)-A(ID+I))-(A(IF+I)-A(IB+I))) + T2=ZSIN45*((A(IH+I)-A(ID+I))+(A(IF+I)-A(IB+I))) & + & +Z*(A(IG+I)-A(IC+I)) + T6=ZSIN45*((A(IH+I)-A(ID+I))+(A(IF+I)-A(IB+I))) & + & -Z*(A(IG+I)-A(IC+I)) + T7=Z*(((A(IA+I)+A(IE+I))+(A(IC+I)+A(IG+I)))- & + & ((A(ID+I)+A(IH+I))+(A(IB+I)+A(IF+I)))) + A(IA+I)=Z*(((A(IA+I)+A(IE+I))+(A(IC+I)+A(IG+I)))+ & + & ((A(ID+I)+A(IH+I))+(A(IB+I)+A(IF+I)))) + A(IB+I)=T1 + A(IC+I)=T2 + A(ID+I)=T3 + A(IE+I)=T4 + A(IF+I)=T5 + A(IG+I)=T6 + A(IH+I)=T7 + I=I+INC3 + 810 CONTINUE + IBASE=IBASE+INC11 + 820 CONTINUE + ELSE + DO 840 L=1,ILA + I=IBASE + J=JBASE +!OCL NOVREC +!DEC$ IVDEP + DO 830 IJK=1,ILOT + C(JA+J)=Z*(((A(IA+I)+A(IE+I))+(A(IC+I)+A(IG+I)))+ & + & ((A(ID+I)+A(IH+I))+(A(IB+I)+A(IF+I)))) + C(JE+J)=Z*(((A(IA+I)+A(IE+I))+(A(IC+I)+A(IG+I)))- & + & ((A(ID+I)+A(IH+I))+(A(IB+I)+A(IF+I)))) + C(JC+J)=Z*((A(IA+I)+A(IE+I))-(A(IC+I)+A(IG+I))) + D(JC+J)=Z*((A(ID+I)+A(IH+I))-(A(IB+I)+A(IF+I))) + C(JB+J)=Z*(A(IA+I)-A(IE+I)) & + & +ZSIN45*((A(IH+I)-A(ID+I))-(A(IF+I)-A(IB+I))) + C(JD+J)=Z*(A(IA+I)-A(IE+I)) & + & -ZSIN45*((A(IH+I)-A(ID+I))-(A(IF+I)-A(IB+I))) + D(JB+J)=ZSIN45*((A(IH+I)-A(ID+I))+(A(IF+I)-A(IB+I))) & + & +Z*(A(IG+I)-A(IC+I)) + D(JD+J)=ZSIN45*((A(IH+I)-A(ID+I))+(A(IF+I)-A(IB+I))) & + & -Z*(A(IG+I)-A(IC+I)) + I=I+INC3 + J=J+INC4 + 830 CONTINUE + IBASE=IBASE+INC11 + JBASE=JBASE+INC2 + 840 CONTINUE + ENDIF +! + ENDIF +! + ELSE +! + IBAD=2 !!! Illegal factor +! + ENDIF +! +! RETURN +! ------ + 900 CONTINUE + IERR=IBAD + ENDSUBROUTINE QPASSF + + ENDSUBROUTINE FFT992 +#endif \ No newline at end of file diff --git a/src/etrans/cpu/internal/set99.F90 b/src/etrans/cpu/internal/set99.F90 new file mode 100644 index 000000000..0ea5f8c4d --- /dev/null +++ b/src/etrans/cpu/internal/set99.F90 @@ -0,0 +1,82 @@ +! (C) Copyright 1998- ECMWF. +! (C) Copyright 2013- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + SUBROUTINE SET99(TRIGS,IFAX,N) +!AUTOPROMOTE + USE PARKIND1, ONLY : JPIM, JPRB + USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK +! + IMPLICIT NONE +! + INTEGER(KIND=JPIM) :: N + INTEGER(KIND=JPIM) :: I,IFAC,IL,IXXX,K,NHL,NIL,NFAX,NU + REAL(KIND=JPRB) :: ANGLE,DEL + REAL(KIND=JPRB) :: TRIGS(N) + INTEGER(KIND=JPIM) :: IFAX(*) + INTEGER(KIND=JPIM) :: JFAX(10),NLFAX(7) +! +! SUBROUTINE 'SET99' - COMPUTES FACTORS OF N & TRIGONOMETRIC +! FUNCTIONS REQUIRED BY FFT99 & FFT991 +! + SAVE NLFAX +! + DATA NLFAX/6,8,5,4,3,2,1/ +! + REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + IF (LHOOK) CALL DR_HOOK('SET99',0,ZHOOK_HANDLE) + IXXX=1 +! + DEL=4.0E0_JPRB*ASIN(1.0E0_JPRB)/REAL(N,KIND=JPRB) + NIL=0 + NHL=(N/2)-1 + DO 10 K=NIL,NHL + ANGLE=REAL(K,KIND=JPRB)*DEL + TRIGS(2*K+1)=COS(ANGLE) + TRIGS(2*K+2)=SIN(ANGLE) + 10 CONTINUE +! +! FIND FACTORS OF N (8,6,5,4,3,2; ONLY ONE 8 ALLOWED) +! LOOK FOR SIXES FIRST, STORE FACTORS IN DESCENDING ORDER + NU=N + IFAC=6 + K=0 + IL=1 + 20 CONTINUE + IF (MOD(NU,IFAC).NE.0) GO TO 30 + K=K+1 + JFAX(K)=IFAC + IF (IFAC.NE.8) GO TO 25 + IF (K.EQ.1) GO TO 25 + JFAX(1)=8 + JFAX(K)=6 + 25 CONTINUE + NU=NU/IFAC + IF (NU.EQ.1) GO TO 50 + IF (IFAC.NE.8) GO TO 20 + 30 CONTINUE + IL=IL+1 + IFAC=NLFAX(IL) + IF (IFAC.GT.1) GO TO 20 +! + WRITE(6,40) N + 40 FORMAT(4H1N =,I4,27H - CONTAINS ILLEGAL FACTORS) + IF (LHOOK) CALL DR_HOOK('SET99',1,ZHOOK_HANDLE) + RETURN +! +! NOW REVERSE ORDER OF FACTORS + 50 CONTINUE + NFAX=K + IFAX(1)=NFAX + DO 60 I=1,NFAX + IFAX(NFAX+2-I)=JFAX(I) + 60 CONTINUE + IFAX(10)=N + IF (LHOOK) CALL DR_HOOK('SET99',1,ZHOOK_HANDLE) + ENDSUBROUTINE SET99 \ No newline at end of file diff --git a/src/etrans/cpu/internal/set99b.F90 b/src/etrans/cpu/internal/set99b.F90 new file mode 100644 index 000000000..ee2a2aff4 --- /dev/null +++ b/src/etrans/cpu/internal/set99b.F90 @@ -0,0 +1,81 @@ +! (C) Copyright 1998- ECMWF. +! (C) Copyright 2013- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + SUBROUTINE SET99B(TRIGS,IFAX,N,LDUSEFFT992) +!AUTOPROMOTE + USE PARKIND1, ONLY : JPIM, JPRB +! + IMPLICIT NONE +! + INTEGER(KIND=JPIM),INTENT(IN) :: N + REAL(KIND=JPRB),INTENT(OUT) :: TRIGS(N) + INTEGER(KIND=JPIM),INTENT(OUT) :: IFAX(*) + LOGICAL,INTENT(OUT) :: LDUSEFFT992 + + INTEGER(KIND=JPIM) :: I,IFAC,IL,IXXX,K,NHL,NIL,NFAX,NU + REAL(KIND=JPRB) :: ANGLE,DEL + INTEGER(KIND=JPIM) :: JFAX(10),NLFAX(7) +! +! SUBROUTINE 'SET99B' - COMPUTES FACTORS OF N & TRIGONOMETRIC +! FUNCTIONS REQUIRED BY FFT992. +! BASED ON SET99, SET99B ALSO RETURNS VIA LUSEFFT992 WHETHER +! FACTORS HAVE BEEN FOUND THAT CAN PERMIT (OR NOT) FFT992 TO BE USED. +! + SAVE NLFAX +! + DATA NLFAX/6,8,5,4,3,2,1/ +! + IXXX=1 +! + DEL=4.0E0_JPRB*ASIN(1.0E0_JPRB)/REAL(N,KIND=JPRB) + NIL=0 + NHL=(N/2)-1 + DO 10 K=NIL,NHL + ANGLE=REAL(K,KIND=JPRB)*DEL + TRIGS(2*K+1)=COS(ANGLE) + TRIGS(2*K+2)=SIN(ANGLE) + 10 CONTINUE +! +! FIND FACTORS OF N (8,6,5,4,3,2; ONLY ONE 8 ALLOWED) +! LOOK FOR SIXES FIRST, STORE FACTORS IN DESCENDING ORDER + NU=N + IFAC=6 + K=0 + IL=1 + 20 CONTINUE + IF (MOD(NU,IFAC).NE.0) GO TO 30 + K=K+1 + JFAX(K)=IFAC + IF (IFAC.NE.8) GO TO 25 + IF (K.EQ.1) GO TO 25 + JFAX(1)=8 + JFAX(K)=6 + 25 CONTINUE + NU=NU/IFAC + IF (NU.EQ.1) GO TO 50 + IF (IFAC.NE.8) GO TO 20 + 30 CONTINUE + IL=IL+1 + IFAC=NLFAX(IL) + IF (IFAC.GT.1) GO TO 20 +! + LDUSEFFT992=.FALSE. + RETURN +! +! NOW REVERSE ORDER OF FACTORS + 50 CONTINUE + NFAX=K + IFAX(1)=NFAX + DO 60 I=1,NFAX + IFAX(NFAX+2-I)=JFAX(I) + 60 CONTINUE + IFAX(10)=N + LDUSEFFT992=.TRUE. + END SUBROUTINE SET99B \ No newline at end of file diff --git a/src/etrans/etrans/internal/suefft_mod.F90 b/src/etrans/cpu/internal/suefft_mod.F90 similarity index 75% rename from src/etrans/etrans/internal/suefft_mod.F90 rename to src/etrans/cpu/internal/suefft_mod.F90 index 96d48790f..9db770469 100644 --- a/src/etrans/etrans/internal/suefft_mod.F90 +++ b/src/etrans/cpu/internal/suefft_mod.F90 @@ -9,14 +9,13 @@ SUBROUTINE SUEFFT USE TPM_GEN ,ONLY : NOUT, NPRINTLEV USE TPM_DISTR ,ONLY : D, MYSETW USE TPM_GEOMETRY ,ONLY : G -USE TPM_FFT ,ONLY : T, TB -#ifdef WITH_FFTW -USE TPM_FFTW ,ONLY : TW, INIT_PLANS_FFTW +#ifdef WITH_FFT992 +USE TPM_FFT ,ONLY : T +USE TPMALD_FFT ,ONLY : TALD #endif -USE BLUESTEIN_MOD ,ONLY : BLUESTEIN_INIT, FFTB_TYPE +USE TPM_FFTW ,ONLY : TW, INIT_PLANS_FFTW ! -USE TPMALD_FFT ,ONLY : TALD ! IMPLICIT NONE @@ -35,15 +34,10 @@ SUBROUTINE SUEFFT LLP2 = NPRINTLEV>1 IF(LLP1) WRITE(NOUT,*) '=== ENTER ROUTINE SUEFFT ===' -#ifdef WITH_FFTW - IF(TW%LFFTW)THEN - - CALL INIT_PLANS_FFTW(MAX(R%NDLON+R%NNOEXTZL,R%NDGL+R%NNOEXTZG)) - - ELSE +#ifdef WITH_FFT992 + IF( TALD%LFFT992 )THEN NULLIFY(TW%FFTW_PLANS) -#endif ALLOCATE(T%TRIGS(R%NDLON+R%NNOEXTZL,D%NDGL_FS)) IF(LLP2)WRITE(NOUT,9) 'T%TRIGS ',SIZE(T%TRIGS),SHAPE(T%TRIGS) @@ -57,7 +51,6 @@ SUBROUTINE SUEFFT ! that is just with factors 2, 3 or 5 ! - T%LBLUESTEIN=.FALSE. ILATS=0 DO JGL=1,D%NDGL_FS IGLG = D%NPTRLS(MYSETW)+JGL-1 @@ -65,42 +58,25 @@ SUBROUTINE SUEFFT CALL SET99B(T%TRIGS(1,JGL),T%NFAX(1,JGL),G%NLOEN(IGLG)+R%NNOEXTZL,T%LUSEFFT992(JGL)) IF( .NOT.T%LUSEFFT992(JGL) )THEN ILATS=ILATS+1 - T%LBLUESTEIN=.TRUE. ENDIF ENDIF ENDDO - - ! - ! we only initialise for bluestein if there are latitude lengths - ! not supported by FFT992 - ! - - IF( T%LBLUESTEIN )THEN - TB%NDLON=R%NDLON - TB%NLAT_COUNT=ILATS - ILATS=0 - ALLOCATE(TB%NLATS(TB%NLAT_COUNT)) - DO JGL=1,D%NDGL_FS - IF( .NOT.T%LUSEFFT992(JGL) )THEN - ILATS=ILATS+1 - TB%NLATS(ILATS)=R%NDLON+R%NNOEXTZL - ENDIF - ENDDO - CALL BLUESTEIN_INIT(TB) - ENDIF - -#ifdef WITH_FFTW - ENDIF -#endif - - IF(TALD%LFFT992)THEN ALLOCATE(TALD%TRIGSE(R%NDGL+R%NNOEXTZG)) IF(LLP2)WRITE(NOUT,9) 'TALD%TRIGSE ',SIZE(TALD%TRIGSE),SHAPE(TALD%TRIGSE) ALLOCATE(TALD%NFAXE(19)) IF(LLP2)WRITE(NOUT,9) 'TALD%NFAXE ',SIZE(TALD%NFAXE),SHAPE(TALD%NFAXE) CALL SET99(TALD%TRIGSE,TALD%NFAXE,R%NDGL+R%NNOEXTZG) + + + ELSE +#endif + + CALL INIT_PLANS_FFTW(MAX(R%NDLON+R%NNOEXTZL,R%NDGL+R%NNOEXTZG)) + +#ifdef WITH_FFT992 ENDIF +#endif ENDIF diff --git a/src/etrans/etrans/internal/suemp_trans_mod.F90 b/src/etrans/cpu/internal/suemp_trans_mod.F90 similarity index 98% rename from src/etrans/etrans/internal/suemp_trans_mod.F90 rename to src/etrans/cpu/internal/suemp_trans_mod.F90 index ae689f5e1..4a1328cd1 100644 --- a/src/etrans/etrans/internal/suemp_trans_mod.F90 +++ b/src/etrans/cpu/internal/suemp_trans_mod.F90 @@ -5,7 +5,7 @@ SUBROUTINE SUEMP_TRANS ! Set up distributed environment for the transform package (part 2) ! R. El Khatib 09-Aug-2013 Allow LEQ_REGIONS -USE PARKIND1 ,ONLY : JPIM ,JPRB +USE PARKIND1 ,ONLY : JPIM ,JPRB, JPRD USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK USE TPM_GEN ,ONLY : NOUT, NPRINTLEV @@ -33,10 +33,10 @@ SUBROUTINE SUEMP_TRANS INTEGER(KIND=JPIM) :: IGPTOT,IMEDIAP,IRESTM,JA,JB,IOFF INTEGER(KIND=JPIM), ALLOCATABLE :: IGPTOTL(:,:) -REAL(KIND=JPRB) :: ZMEDIAP +REAL(KIND=JPRD) :: ZMEDIAP LOGICAL :: LLP1,LLP2 -REAL(KIND=JPRB),ALLOCATABLE :: ZDUM(:) +REAL(KIND=JPRD),ALLOCATABLE :: ZDUM(:) REAL(KIND=JPHOOK) :: ZHOOK_HANDLE ! ------------------------------------------------------------------ diff --git a/src/etrans/etrans/internal/suemp_trans_preleg_mod.F90 b/src/etrans/cpu/internal/suemp_trans_preleg_mod.F90 similarity index 100% rename from src/etrans/etrans/internal/suemp_trans_preleg_mod.F90 rename to src/etrans/cpu/internal/suemp_trans_preleg_mod.F90 diff --git a/src/etrans/etrans/internal/suemplat_mod.F90 b/src/etrans/cpu/internal/suemplat_mod.F90 similarity index 98% rename from src/etrans/etrans/internal/suemplat_mod.F90 rename to src/etrans/cpu/internal/suemplat_mod.F90 index c06f31695..981497e02 100644 --- a/src/etrans/etrans/internal/suemplat_mod.F90 +++ b/src/etrans/cpu/internal/suemplat_mod.F90 @@ -82,7 +82,7 @@ SUBROUTINE SUEMPLAT(KDGL,KPROC,KPROCA,KMYSETA,LDSPLIT,LDEQ_REGIONS,& ! R. El Khatib 09-Aug-2013 Allow LEQ_REGIONS ! ------------------------------------------------------------------ -USE PARKIND1 ,ONLY : JPIM ,JPRB +USE PARKIND1 ,ONLY : JPIM ,JPRB, JPRD USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK USE TPM_GEN ,ONLY : NOUT, NPRINTLEV @@ -109,8 +109,8 @@ SUBROUTINE SUEMPLAT(KDGL,KPROC,KPROCA,KMYSETA,LDSPLIT,LDEQ_REGIONS,& INTEGER(KIND=JPIM),INTENT(OUT) :: KPTRLSTLAT(:) INTEGER(KIND=JPIM),INTENT(OUT) :: KPTRFLOFF INTEGER(KIND=JPIM),INTENT(OUT) :: KPROCAGP(KPROCA) -REAL(KIND=JPRB),INTENT(OUT) :: PMEDIAP -REAL(KIND=JPRB),INTENT(IN) :: PWEIGHT(:) +REAL(KIND=JPRD),INTENT(OUT) :: PMEDIAP +REAL(KIND=JPRD),INTENT(IN) :: PWEIGHT(:) LOGICAL,INTENT(IN) :: LDSPLIT LOGICAL,INTENT(IN) :: LDEQ_REGIONS @@ -124,6 +124,7 @@ SUBROUTINE SUEMPLAT(KDGL,KPROC,KPROCA,KMYSETA,LDSPLIT,LDEQ_REGIONS,& INTEGER(KIND=JPIM) :: INDIC(KPROCA),ILAST(KPROCA) INTEGER(KIND=JPIM) :: IPTRLATITUDE, JA, JGL + REAL(KIND=JPHOOK) :: ZHOOK_HANDLE LOGICAL :: LLFOURIER @@ -144,6 +145,7 @@ SUBROUTINE SUEMPLAT(KDGL,KPROC,KPROCA,KMYSETA,LDSPLIT,LDEQ_REGIONS,& CALL ABORT_TRANS ('SUEMPLAT: LDWEIGHTED_DISTR=T AND LDEQ_REGIONS=F NOT SUPPORTED') ENDIF + IF( LDEQ_REGIONS )THEN CALL SUMPLATBEQ(1,KDGL,KPROC,KPROCA,KLOEN,LDSPLIT,LDEQ_REGIONS,& &PWEIGHT,LDWEIGHTED_DISTR,PMEDIAP,KPROCAGP,& diff --git a/src/etrans/etrans/internal/suemplatb_mod.F90 b/src/etrans/cpu/internal/suemplatb_mod.F90 similarity index 98% rename from src/etrans/etrans/internal/suemplatb_mod.F90 rename to src/etrans/cpu/internal/suemplatb_mod.F90 index a7361777b..94ca0287f 100644 --- a/src/etrans/etrans/internal/suemplatb_mod.F90 +++ b/src/etrans/cpu/internal/suemplatb_mod.F90 @@ -63,7 +63,7 @@ SUBROUTINE SUEMPLATB(KDGSA,KDGL,KPROCA,KLOENG,LDSPLIT,& ! A.Bogatchev 21-Sep-2010 phasing CY37 ! ------------------------------------------------------------------ -USE PARKIND1 ,ONLY : JPIM ,JPRB +USE PARKIND1 ,ONLY : JPIM ,JPRB, JPRD USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS @@ -76,7 +76,7 @@ SUBROUTINE SUEMPLATB(KDGSA,KDGL,KPROCA,KLOENG,LDSPLIT,& INTEGER(KIND=JPIM),INTENT(IN) :: KDGL INTEGER(KIND=JPIM),INTENT(IN) :: KPROCA INTEGER(KIND=JPIM),INTENT(IN) :: KLOENG(KDGSA:KDGL) -REAL(KIND=JPRB),INTENT(IN) :: PWEIGHT(:) +REAL(KIND=JPRD),INTENT(IN) :: PWEIGHT(:) LOGICAL,INTENT(IN) :: LDSPLIT LOGICAL,INTENT(INOUT) :: LDWEIGHTED_DISTR INTEGER(KIND=JPIM),INTENT(IN) :: KDGUX @@ -85,7 +85,7 @@ SUBROUTINE SUEMPLATB(KDGSA,KDGL,KPROCA,KLOENG,LDSPLIT,& INTEGER(KIND=JPIM),INTENT(OUT) :: KINDIC(KPROCA) INTEGER(KIND=JPIM),INTENT(OUT) :: KLAST(KPROCA) INTEGER(KIND=JPIM),INTENT(IN) :: KPROCAGP(KPROCA) -REAL(KIND=JPRB),INTENT(IN) :: PMEDIAP +REAL(KIND=JPRD),INTENT(IN) :: PMEDIAP INTEGER(KIND=JPIM) :: IPP1(KPROCA),ILAST1(KPROCA) INTEGER(KIND=JPIM) :: IPP(KPROCA) diff --git a/src/etrans/etrans/internal/suestaonl_mod.F90 b/src/etrans/cpu/internal/suestaonl_mod.F90 similarity index 99% rename from src/etrans/etrans/internal/suestaonl_mod.F90 rename to src/etrans/cpu/internal/suestaonl_mod.F90 index 7cd384d53..f32fea14b 100644 --- a/src/etrans/etrans/internal/suestaonl_mod.F90 +++ b/src/etrans/cpu/internal/suestaonl_mod.F90 @@ -58,7 +58,7 @@ SUBROUTINE SUESTAONL(KMEDIAP,KRESTM,LDWEIGHTED_DISTR,PWEIGHT,PMEDIAP,KPROCAGP) ! R. El Khatib 26-Apr-2018 vectorization ! ------------------------------------------------------------------ -USE PARKIND1 ,ONLY : JPIM ,JPRB +USE PARKIND1 ,ONLY : JPIM ,JPRB, JPRD USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK USE MPL_MODULE ,ONLY : MPL_ALLGATHERV, MPL_RECV, MPL_SEND @@ -77,9 +77,9 @@ SUBROUTINE SUESTAONL(KMEDIAP,KRESTM,LDWEIGHTED_DISTR,PWEIGHT,PMEDIAP,KPROCAGP) INTEGER(KIND=JPIM),INTENT(IN) :: KMEDIAP INTEGER(KIND=JPIM),INTENT(IN) :: KRESTM -REAL(KIND=JPRB),INTENT(IN) :: PWEIGHT(:) +REAL(KIND=JPRD),INTENT(IN) :: PWEIGHT(:) LOGICAL,INTENT(IN) :: LDWEIGHTED_DISTR -REAL(KIND=JPRB),INTENT(IN) :: PMEDIAP +REAL(KIND=JPRD),INTENT(IN) :: PMEDIAP INTEGER(KIND=JPIM),INTENT(IN) :: KPROCAGP(:) INTEGER(KIND=JPIM) :: IXPTLAT(R%NDGL), ILSTPTLAT(R%NDGL) diff --git a/src/etrans/cpu/internal/tpm_fft.F90 b/src/etrans/cpu/internal/tpm_fft.F90 new file mode 100644 index 000000000..a836d5ca1 --- /dev/null +++ b/src/etrans/cpu/internal/tpm_fft.F90 @@ -0,0 +1,30 @@ +! (C) Copyright 2000- ECMWF. +! (C) Copyright 2000- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + +MODULE TPM_FFT +USE PARKIND1 ,ONLY : JPIM ,JPRB + +! Module for Fourier transforms. + +IMPLICIT NONE + +SAVE + +TYPE FFT_TYPE + REAL(KIND=JPRB) ,ALLOCATABLE :: TRIGS(:,:) ! list of trigonometric function values + INTEGER(KIND=JPIM),ALLOCATABLE :: NFAX(:,:) ! list of factors of truncation + LOGICAL,ALLOCATABLE :: LUSEFFT992(:) ! describes which FFT algorithm to be used + ! T=use FFT992 F=use bluestein +END TYPE FFT_TYPE + +TYPE(FFT_TYPE),ALLOCATABLE,TARGET :: FFT_RESOL(:) +TYPE(FFT_TYPE),POINTER :: T + +END MODULE TPM_FFT \ No newline at end of file diff --git a/src/etrans/etrans/internal/tpmald_dim.F90 b/src/etrans/cpu/internal/tpmald_dim.F90 similarity index 100% rename from src/etrans/etrans/internal/tpmald_dim.F90 rename to src/etrans/cpu/internal/tpmald_dim.F90 diff --git a/src/etrans/etrans/internal/tpmald_distr.F90 b/src/etrans/cpu/internal/tpmald_distr.F90 similarity index 100% rename from src/etrans/etrans/internal/tpmald_distr.F90 rename to src/etrans/cpu/internal/tpmald_distr.F90 diff --git a/src/etrans/etrans/internal/tpmald_fft.F90 b/src/etrans/cpu/internal/tpmald_fft.F90 similarity index 90% rename from src/etrans/etrans/internal/tpmald_fft.F90 rename to src/etrans/cpu/internal/tpmald_fft.F90 index 337dadee6..004eb04e6 100644 --- a/src/etrans/etrans/internal/tpmald_fft.F90 +++ b/src/etrans/cpu/internal/tpmald_fft.F90 @@ -11,7 +11,7 @@ MODULE TPMALD_FFT TYPE ALDFFT_TYPE REAL(KIND=JPRB) ,POINTER :: TRIGSE(:) ! list of trigonometric function values INTEGER(KIND=JPIM),POINTER :: NFAXE(:) ! list of factors of truncation -LOGICAL :: LFFT992=.TRUE. +LOGICAL :: LFFT992=.FALSE. END TYPE ALDFFT_TYPE TYPE(ALDFFT_TYPE),ALLOCATABLE,TARGET :: ALDFFT_RESOL(:) diff --git a/src/etrans/etrans/internal/tpmald_fields.F90 b/src/etrans/cpu/internal/tpmald_fields.F90 similarity index 100% rename from src/etrans/etrans/internal/tpmald_fields.F90 rename to src/etrans/cpu/internal/tpmald_fields.F90 diff --git a/src/etrans/etrans/internal/tpmald_geo.F90 b/src/etrans/cpu/internal/tpmald_geo.F90 similarity index 100% rename from src/etrans/etrans/internal/tpmald_geo.F90 rename to src/etrans/cpu/internal/tpmald_geo.F90 diff --git a/src/etrans/etrans/internal/tpmald_tcdis.F90 b/src/etrans/cpu/internal/tpmald_tcdis.F90 similarity index 100% rename from src/etrans/etrans/internal/tpmald_tcdis.F90 rename to src/etrans/cpu/internal/tpmald_tcdis.F90 diff --git a/src/etrans/etrans/include/edir_trans.h b/src/etrans/include/etrans/edir_trans.h similarity index 100% rename from src/etrans/etrans/include/edir_trans.h rename to src/etrans/include/etrans/edir_trans.h diff --git a/src/etrans/etrans/include/edir_transad.h b/src/etrans/include/etrans/edir_transad.h similarity index 100% rename from src/etrans/etrans/include/edir_transad.h rename to src/etrans/include/etrans/edir_transad.h diff --git a/src/etrans/etrans/include/edist_grid.h b/src/etrans/include/etrans/edist_grid.h similarity index 100% rename from src/etrans/etrans/include/edist_grid.h rename to src/etrans/include/etrans/edist_grid.h diff --git a/src/etrans/etrans/include/edist_spec.h b/src/etrans/include/etrans/edist_spec.h similarity index 100% rename from src/etrans/etrans/include/edist_spec.h rename to src/etrans/include/etrans/edist_spec.h diff --git a/src/etrans/etrans/include/egath_grid.h b/src/etrans/include/etrans/egath_grid.h similarity index 100% rename from src/etrans/etrans/include/egath_grid.h rename to src/etrans/include/etrans/egath_grid.h diff --git a/src/etrans/etrans/include/egath_spec.h b/src/etrans/include/etrans/egath_spec.h similarity index 100% rename from src/etrans/etrans/include/egath_spec.h rename to src/etrans/include/etrans/egath_spec.h diff --git a/src/etrans/etrans/include/egpnorm_trans.h b/src/etrans/include/etrans/egpnorm_trans.h similarity index 100% rename from src/etrans/etrans/include/egpnorm_trans.h rename to src/etrans/include/etrans/egpnorm_trans.h diff --git a/src/etrans/etrans/include/einv_trans.h b/src/etrans/include/etrans/einv_trans.h similarity index 100% rename from src/etrans/etrans/include/einv_trans.h rename to src/etrans/include/etrans/einv_trans.h diff --git a/src/etrans/etrans/include/einv_transad.h b/src/etrans/include/etrans/einv_transad.h similarity index 100% rename from src/etrans/etrans/include/einv_transad.h rename to src/etrans/include/etrans/einv_transad.h diff --git a/src/etrans/etrans/include/esetup_trans.h b/src/etrans/include/etrans/esetup_trans.h similarity index 100% rename from src/etrans/etrans/include/esetup_trans.h rename to src/etrans/include/etrans/esetup_trans.h diff --git a/src/etrans/etrans/include/especnorm.h b/src/etrans/include/etrans/especnorm.h similarity index 100% rename from src/etrans/etrans/include/especnorm.h rename to src/etrans/include/etrans/especnorm.h diff --git a/src/etrans/biper/include/etibihie.h b/src/etrans/include/etrans/etibihie.h similarity index 100% rename from src/etrans/biper/include/etibihie.h rename to src/etrans/include/etrans/etibihie.h diff --git a/src/etrans/etrans/include/etrans_end.h b/src/etrans/include/etrans/etrans_end.h similarity index 100% rename from src/etrans/etrans/include/etrans_end.h rename to src/etrans/include/etrans/etrans_end.h diff --git a/src/etrans/etrans/include/etrans_inq.h b/src/etrans/include/etrans/etrans_inq.h similarity index 100% rename from src/etrans/etrans/include/etrans_inq.h rename to src/etrans/include/etrans/etrans_inq.h diff --git a/src/etrans/etrans/include/etrans_release.h b/src/etrans/include/etrans/etrans_release.h similarity index 100% rename from src/etrans/etrans/include/etrans_release.h rename to src/etrans/include/etrans/etrans_release.h diff --git a/src/etrans/biper/include/fpbipere.h b/src/etrans/include/etrans/fpbipere.h similarity index 100% rename from src/etrans/biper/include/fpbipere.h rename to src/etrans/include/etrans/fpbipere.h diff --git a/src/etrans/biper/include/horiz_field.h b/src/etrans/include/etrans/horiz_field.h similarity index 100% rename from src/etrans/biper/include/horiz_field.h rename to src/etrans/include/etrans/horiz_field.h diff --git a/src/etrans/sedrenames.txt b/src/etrans/sedrenames.txt new file mode 100644 index 000000000..016e2c606 --- /dev/null +++ b/src/etrans/sedrenames.txt @@ -0,0 +1,149 @@ +s/ASRE1_MOD/ASRE1_MOD_VARIANTDESIGNATOR/g +s/ASRE1AD_MOD/ASRE1AD_MOD_VARIANTDESIGNATOR/g +s/ASRE1B_MOD/ASRE1B_MOD_VARIANTDESIGNATOR/g +s/ASRE1BAD_MOD/ASRE1BAD_MOD_VARIANTDESIGNATOR/g +s/BUTTERFLY_ALG_MOD/BUTTERFLY_ALG_MOD_VARIANTDESIGNATOR/g +s/CDMAP_MOD/CDMAP_MOD_VARIANTDESIGNATOR/g +s/DEALLOC_RESOL_MOD/DEALLOC_RESOL_MOD_VARIANTDESIGNATOR/g +s/DIR_TRANS_CTL_MOD/DIR_TRANS_CTL_MOD_VARIANTDESIGNATOR/g +s/DIR_TRANS_CTLAD_MOD/DIR_TRANS_CTLAD_MOD_VARIANTDESIGNATOR/g +s/dir_trans( *($|\(| |\*))/dir_trans_VARIANTDESIGNATOR\1/g +s/DIR_TRANS( *($|\(| |\*))/DIR_TRANS_VARIANTDESIGNATOR\1/g +s/dir_transad( *($|\(| |\*))/dir_transad_VARIANTDESIGNATOR\1/g +s/DIR_TRANSAD( *($|\(| |\*))/DIR_TRANSAD_VARIANTDESIGNATOR\1/g +s/DIST_GRID_32_CTL_MOD/DIST_GRID_32_CTL_MOD_VARIANTDESIGNATOR/g +s/dist_grid_32( *($|\(| |\*))/dist_grid_32_VARIANTDESIGNATOR\1/g +s/DIST_GRID_32( *($|\(| |\*))/DIST_GRID_32_VARIANTDESIGNATOR\1/g +s/DIST_GRID_CTL_MOD/DIST_GRID_CTL_MOD_VARIANTDESIGNATOR/g +s/dist_grid( *($|\(| |\*))/dist_grid_VARIANTDESIGNATOR\1/g +s/DIST_GRID( *($|\(| |\*))/DIST_GRID_VARIANTDESIGNATOR\1/g +s/DIST_SPEC_CONTROL_MOD/DIST_SPEC_CONTROL_MOD_VARIANTDESIGNATOR/g +s/dist_spec( *($|\(| |\*))/dist_spec_VARIANTDESIGNATOR\1/g +s/DIST_SPEC( *($|\(| |\*))/DIST_SPEC_VARIANTDESIGNATOR\1/g +s/ectrans_mod/ectrans_mod_VARIANTDESIGNATOR/g +s/FFTB_PLAN/FFTB_PLAN_VARIANTDESIGNATOR/g +s/FFTB_TYPE/FFTB_TYPE_VARIANTDESIGNATOR/g +s/FOURIER_IN_MOD/FOURIER_IN_MOD_VARIANTDESIGNATOR/g +s/FOURIER_INAD_MOD/FOURIER_INAD_MOD_VARIANTDESIGNATOR/g +s/FOURIER_OUT_MOD/FOURIER_OUT_MOD_VARIANTDESIGNATOR/g +s/FOURIER_OUTAD_MOD/FOURIER_OUTAD_MOD_VARIANTDESIGNATOR/g +s/FSC_MOD/FSC_MOD_VARIANTDESIGNATOR/g +s/FSCAD_MOD/FSCAD_MOD_VARIANTDESIGNATOR/g +s/FSPGL_INT_MOD/FSPGL_INT_MOD_VARIANTDESIGNATOR/g +s/FTDIR_CTL_MOD/FTDIR_CTL_MOD_VARIANTDESIGNATOR/g +s/FTDIR_CTLAD_MOD/FTDIR_CTLAD_MOD_VARIANTDESIGNATOR/g +s/FTDIR_MOD/FTDIR_MOD_VARIANTDESIGNATOR/g +s/FTDIRAD_MOD/FTDIRAD_MOD_VARIANTDESIGNATOR/g +s/FTINV_CTL_MOD/FTINV_CTL_MOD_VARIANTDESIGNATOR/g +s/FTINV_CTLAD_MOD/FTINV_CTLAD_MOD_VARIANTDESIGNATOR/g +s/FTINV_MOD/FTINV_MOD_VARIANTDESIGNATOR/g +s/FTINVAD_MOD/FTINVAD_MOD_VARIANTDESIGNATOR/g +s/GATH_GRID_32_CTL_MOD/GATH_GRID_32_CTL_MOD_VARIANTDESIGNATOR/g +s/gath_grid_32( *($|\(| |\*))/gath_grid_32_VARIANTDESIGNATOR\1/g +s/GATH_GRID_32( *($|\(| |\*))/GATH_GRID_32_VARIANTDESIGNATOR\1/g +s/GATH_GRID_CTL_MOD/GATH_GRID_CTL_MOD_VARIANTDESIGNATOR/g +s/gath_grid( *($|\(| |\*))/gath_grid_VARIANTDESIGNATOR\1/g +s/GATH_GRID( *($|\(| |\*))/GATH_GRID_VARIANTDESIGNATOR\1/g +s/GATH_SPEC_CONTROL_MOD/GATH_SPEC_CONTROL_MOD_VARIANTDESIGNATOR/g +s/gath_spec( *($|\(| |\*))/gath_spec_VARIANTDESIGNATOR\1/g +s/GATH_SPEC( *($|\(| |\*))/GATH_SPEC_VARIANTDESIGNATOR\1/g +s/GPNORM_TRANS_GPU( *($|\(| |\*))/GPNORM_TRANS_GPU_VARIANTDESIGNATOR\1/g +s/GPNORM_TRANS_CTL_MOD/GPNORM_TRANS_CTL_MOD_VARIANTDESIGNATOR/g +s/gpnorm_trans( *($|\(| |\*))/gpnorm_trans_VARIANTDESIGNATOR\1/g +s/GPNORM_TRANS( *($|\(| |\*))/GPNORM_TRANS_VARIANTDESIGNATOR\1/g +s/INIGPTR_MOD/INIGPTR_MOD_VARIANTDESIGNATOR/g +s/INV_TRANS_CTL_MOD/INV_TRANS_CTL_MOD_VARIANTDESIGNATOR/g +s/INV_TRANS_CTLAD_MOD/INV_TRANS_CTLAD_MOD_VARIANTDESIGNATOR/g +s/inv_trans( *($|\(| |\*))/inv_trans_VARIANTDESIGNATOR\1/g +s/INV_TRANS( *($|\(| |\*))/INV_TRANS_VARIANTDESIGNATOR\1/g +s/inv_transad( *($|\(| |\*))/inv_transad_VARIANTDESIGNATOR\1/g +s/INV_TRANSAD/INV_TRANSAD_VARIANTDESIGNATOR/g +s/jprbt/TYPEDESIGNATOR_LOWER/g +s/JPRBT/TYPEDESIGNATOR_UPPER/g +s/jprb/TYPEDESIGNATOR_LOWER/g +s/JPRB/TYPEDESIGNATOR_UPPER/g +s/JPRH/JPRD/g +s/LDFOU2_MOD/LDFOU2_MOD_VARIANTDESIGNATOR/g +s/LDFOU2AD_MOD/LDFOU2AD_MOD_VARIANTDESIGNATOR/g +s/LEDIR_MOD/LEDIR_MOD_VARIANTDESIGNATOR/g +s/LEDIRAD_MOD/LEDIRAD_MOD_VARIANTDESIGNATOR/g +s/LEINV_MOD/LEINV_MOD_VARIANTDESIGNATOR/g +s/LEINVAD_MOD/LEINVAD_MOD_VARIANTDESIGNATOR/g +s/LTDIR_CTL_MOD/LTDIR_CTL_MOD_VARIANTDESIGNATOR/g +s/LTDIR_CTLAD_MOD/LTDIR_CTLAD_MOD_VARIANTDESIGNATOR/g +s/LTDIR_MOD/LTDIR_MOD_VARIANTDESIGNATOR/g +s/LTDIRAD_MOD/LTDIRAD_MOD_VARIANTDESIGNATOR/g +s/LTINV_CTL_MOD/LTINV_CTL_MOD_VARIANTDESIGNATOR/g +s/LTINV_CTLAD_MOD/LTINV_CTLAD_MOD_VARIANTDESIGNATOR/g +s/LTINV_MOD/LTINV_MOD_VARIANTDESIGNATOR/g +s/LTINVAD_MOD/LTINVAD_MOD_VARIANTDESIGNATOR/g +s/parkind1/ec_parkind/g +s/PARKIND1/EC_PARKIND/g +s/PARKIND2/EC_PARKIND/g +s/parkind_ectrans/ec_parkind/g +s/PARKIND_ECTRANS/ec_parkind/g +s/PREPSNM_MOD/PREPSNM_MOD_VARIANTDESIGNATOR/g +s/PRFI1_MOD/PRFI1_MOD_VARIANTDESIGNATOR/g +s/PRFI1AD_MOD/PRFI1AD_MOD_VARIANTDESIGNATOR/g +s/PRFI1B_MOD/PRFI1B_MOD_VARIANTDESIGNATOR/g +s/PRFI1BAD_MOD/PRFI1BAD_MOD_VARIANTDESIGNATOR/g +s/PRFI2_MOD/PRFI2_MOD_VARIANTDESIGNATOR/g +s/PRFI2AD_MOD/PRFI2AD_MOD_VARIANTDESIGNATOR/g +s/PRFI2B_MOD/PRFI2B_MOD_VARIANTDESIGNATOR/g +s/PRFI2BAD_MOD/PRFI2BAD_MOD_VARIANTDESIGNATOR/g +s/READ_LEGPOL_MOD/READ_LEGPOL_MOD_VARIANTDESIGNATOR/g +s/seefmm_mix/seefmm_mix_VARIANTDESIGNATOR/g +s/SEEFMM_MIX/SEEFMM_MIX_VARIANTDESIGNATOR/g +s/SET_RESOL_MOD/SET_RESOL_MOD_VARIANTDESIGNATOR/g +s/SETUP_TRANS( *($|\(| |\*))/SETUP_TRANS_VARIANTDESIGNATOR\1/g +s/setup_trans( *($|\(| |\*|\.h))/setup_trans_VARIANTDESIGNATOR\1/g +s/specnorm/specnorm_VARIANTDESIGNATOR/g +s/SPECNORM/SPECNORM_VARIANTDESIGNATOR/g +s/SPNORM_CTL_MOD/SPNORM_CTL_MOD_VARIANTDESIGNATOR/g +s/SPNORMC_MOD/SPNORMC_MOD_VARIANTDESIGNATOR/g +s/SPNORMD_MOD/SPNORMD_MOD_VARIANTDESIGNATOR/g +s/SPNSDE_MOD/SPNSDE_MOD_VARIANTDESIGNATOR/g +s/SPNSDEAD_MOD/SPNSDEAD_MOD_VARIANTDESIGNATOR/g +s/SUFFT_MOD/SUFFT_MOD_VARIANTDESIGNATOR/g +s/SUMP_TRANS_MOD/SUMP_TRANS_MOD_VARIANTDESIGNATOR/g +s/\ SULEG_MOD/\ SULEG_MOD_VARIANTDESIGNATOR/g +s/SUTRLE_MOD/SUTRLE_MOD_VARIANTDESIGNATOR/g +s/TPM_FFTW/TPM_FFTW_VARIANTDESIGNATOR/g +s/TPM_FFT/TPM_FFT_VARIANTDESIGNATOR/g +s/TPM_FIELDS_FLAT/TPM_FIELDS_FLAT_VARIANTDESIGNATOR/g +s/TPM_FLT/TPM_FLT_VARIANTDESIGNATOR/g +s/TPM_TRANS/TPM_TRANS_VARIANTDESIGNATOR/g +s/trans_end( *($|\(| |\*|\.h))/trans_end_VARIANTDESIGNATOR\1/g +s/TRANS_END/TRANS_END_VARIANTDESIGNATOR/g +s/trans_inq( *($|\(| |\*))/trans_inq_VARIANTDESIGNATOR\1/g +s/TRANS_INQ/TRANS_INQ_VARIANTDESIGNATOR/g +s/TRANS_PNM/TRANS_PNM_VARIANTDESIGNATOR/g +s/trans_release( *($|\(| |\*|\.h))/trans_release_VARIANTDESIGNATOR\1/g +s/TRANS_RELEASE/TRANS_RELEASE_VARIANTDESIGNATOR/g +s/TRGTOL_MOD/TRGTOL_MOD_VARIANTDESIGNATOR/g +s/TRLTOG_MOD/TRLTOG_MOD_VARIANTDESIGNATOR/g +s/TRLTOM_MOD/TRLTOM_MOD_VARIANTDESIGNATOR/g +s/TRMTOL_MOD/TRMTOL_MOD_VARIANTDESIGNATOR/g +s/TRMTOL_PACK_UNPACK/TRMTOL_PACK_UNPACK_VARIANTDESIGNATOR/g +s/TRLTOM_PACK_UNPACK/TRLTOM_PACK_UNPACK_VARIANTDESIGNATOR/g +s/UPDSP_MOD/UPDSP_MOD_VARIANTDESIGNATOR/g +s/UPDSPAD_MOD/UPDSPAD_MOD_VARIANTDESIGNATOR/g +s/UPDSPB_MOD/UPDSPB_MOD_VARIANTDESIGNATOR/g +s/UPDSPBAD_MOD/UPDSPBAD_MOD_VARIANTDESIGNATOR/g +s/UVTVD_MOD/UVTVD_MOD_VARIANTDESIGNATOR/g +s/UVTVDAD_MOD/UVTVDAD_MOD_VARIANTDESIGNATOR/g +s/VD2UV_CTL_MOD/VD2UV_CTL_MOD_VARIANTDESIGNATOR/g +s/VD2UV_MOD/VD2UV_MOD_VARIANTDESIGNATOR/g +s/VDTUV_MOD/VDTUV_MOD_VARIANTDESIGNATOR/g +s/VDTUVAD_MOD/VDTUVAD_MOD_VARIANTDESIGNATOR/g +s/VORDIV_TO_UV/VORDIV_TO_UV_VARIANTDESIGNATOR/g +s/WRITE_LEGPOL_MOD/WRITE_LEGPOL_MOD_VARIANTDESIGNATOR/g +s/EXTPER_MOD/EXTPER_MOD_VARIANTDESIGNATOR/g +s/ESPLINE_MOD/ESPLINE_MOD_VARIANTDESIGNATOR/g +s/ESMOOTHE_MOD/ESMOOTHE_MOD_VARIANTDESIGNATOR/g +s/EWINDOWE_MOD/EWINDOWE_MOD_VARIANTDESIGNATOR/g +s/EUVTVD_COMM_MOD/EUVTVD_COMM_MOD_VARIANTDESIGNATOR/g +s/EVDTUVAD_COMM_MOD/EVDTUVAD_COMM_MOD_VARIANTDESIGNATOR/g +s/SUEMPLATB_MOD/SUEMPLATB_MOD_VARIANTDESIGNATOR/g +s/SUEMPLAT_MOD/SUEMPLAT_MOD_VARIANTDESIGNATOR/g +s/SUESTAONL_MOD/SUESTAONL_MOD_VARIANTDESIGNATOR/g diff --git a/src/programs/CMakeLists.txt b/src/programs/CMakeLists.txt index 2f19ef0ec..883618987 100644 --- a/src/programs/CMakeLists.txt +++ b/src/programs/CMakeLists.txt @@ -60,6 +60,8 @@ if ( HAVE_ETRANS ) fiat parkind_${prec} trans_${prec} + etrans_${prec} + OpenMP::OpenMP_Fortran ) endif() endforeach() From b39dc34c450fb589b750722026ea52baba8c3131 Mon Sep 17 00:00:00 2001 From: Daan Degrauwe Date: Tue, 3 Dec 2024 13:39:09 +0000 Subject: [PATCH 14/25] Added LAM test --- src/programs/CMakeLists.txt | 2 +- src/programs/ectrans-lam-benchmark.F90 | 3 +- tests/CMakeLists.txt | 58 +++++++++++++++++++++++++- 3 files changed, 59 insertions(+), 4 deletions(-) diff --git a/src/programs/CMakeLists.txt b/src/programs/CMakeLists.txt index 883618987..d5dfbf8da 100644 --- a/src/programs/CMakeLists.txt +++ b/src/programs/CMakeLists.txt @@ -54,7 +54,7 @@ endforeach( program ) if ( HAVE_ETRANS ) foreach( prec sp dp ) if( HAVE_${prec} ) - ecbuild_add_executable(TARGET ectrans-lam-benchmark-${prec} + ecbuild_add_executable(TARGET ectrans-lam-benchmark-cpu-${prec} SOURCES ectrans-lam-benchmark.F90 LIBS fiat diff --git a/src/programs/ectrans-lam-benchmark.F90 b/src/programs/ectrans-lam-benchmark.F90 index da066ae76..12032a004 100644 --- a/src/programs/ectrans-lam-benchmark.F90 +++ b/src/programs/ectrans-lam-benchmark.F90 @@ -138,7 +138,6 @@ program ectrans_lam_benchmark integer(kind=jpim) :: nmax_resol = 37 ! Max number of resolutions integer(kind=jpim) :: npromatr = 0 ! nproma for trans lib -integer(kind=jpim) :: ncombflen = 1800000 ! Size of comm buffer integer(kind=jpim) :: nproc ! Number of procs integer(kind=jpim) :: nthread @@ -332,7 +331,7 @@ program ectrans_lam_benchmark if( lstats ) call gstats(1, 0) call setup_trans0(kout=nout, kerr=nerr, kprintlev=merge(2, 0, verbosity == 1), & & kmax_resol=nmax_resol, kpromatr=0, kprgpns=nprgpns, kprgpew=nprgpew, & - & kprtrw=nprtrw, kcombflen=ncombflen, ldsync_trans=lsync_trans, & + & kprtrw=nprtrw, ldsync_trans=lsync_trans, & & ldalloperm=.true., ldmpoff=.not.luse_mpi) if( lstats ) call gstats(1, 1) diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt index 9ba9cfe51..4daaf9f8d 100644 --- a/tests/CMakeLists.txt +++ b/tests/CMakeLists.txt @@ -71,7 +71,6 @@ if( HAVE_TESTS ) target_link_libraries( ectrans_test_adjoint OpenMP::OpenMP_Fortran ) endif() - foreach( prec dp sp ) if( TARGET ectrans-benchmark-cpu-${prec} ) set( ntasks 0 ) @@ -131,6 +130,63 @@ if( HAVE_TESTS ) endif() endforeach() + if( HAVE_ETRANS ) + foreach( prec dp sp ) + if( TARGET ectrans-lam-benchmark-cpu-${prec} ) + set( ntasks 0 ) + set( nthreads 1 ) + if( HAVE_MPI ) + list( APPEND ntasks 1 2 ) + endif() + if( HAVE_OMP ) + list( APPEND nthreads 4 8 ) + endif() + foreach( mpi ${ntasks} ) + foreach( omp ${nthreads} ) + set( nlon 48 ) + set( nlat 40 ) + ecbuild_add_test( TARGET ectrans_lam_test_benchmark_${prec}_${nlon}x${nlat}_mpi${mpi}_omp${omp}_nfld0 + COMMAND ectrans-lam-benchmark-cpu-${prec} ARGS --nlon ${nlon} --nlat ${nlat} --niter 2 --nfld 0 --meminfo --check 100 --norms -v + MPI ${mpi} + OMP ${omp} + ) + ecbuild_add_test( TARGET ectrans_lam_test_benchmark_${prec}_${nlon}x${nlat}_mpi${mpi}_omp${omp}_nfld10 + COMMAND ectrans-lam-benchmark-cpu-${prec} ARGS --nlon ${nlon} --nlat ${nlat} --niter 2 --nfld 10 --meminfo --check 100 --norms -v + MPI ${mpi} + OMP ${omp} + ) + ecbuild_add_test( TARGET ectrans_lam_test_benchmark_${prec}_${nlon}x${nlat}_mpi${mpi}_omp${omp}_nfld10_nlev20 + COMMAND ectrans-lam-benchmark-cpu-${prec} ARGS --nlon ${nlon} --nlat ${nlat} --niter 2 --nfld 10 --nlev 20 --check 100 --norms -v + MPI ${mpi} + OMP ${omp} + ) + ecbuild_add_test( TARGET ectrans_lam_test_benchmark_${prec}_${nlon}x${nlat}_mpi${mpi}_omp${omp}_nfld10_nlev20_scders + COMMAND ectrans-lam-benchmark-cpu-${prec} ARGS --nlon ${nlon} --nlat ${nlat} --niter 2 --nfld 10 --nlev 20 --scders --check 100 --norms -v + MPI ${mpi} + OMP ${omp} + ) + ecbuild_add_test( TARGET ectrans_lam_test_benchmark_${prec}_${nlon}x${nlat}_mpi${mpi}_omp${omp}_nfld10_nlev20_vordiv + COMMAND ectrans-lam-benchmark-cpu-${prec} ARGS --nlon ${nlon} --nlat ${nlat} --niter 2 --nfld 10 --nlev 20 --vordiv --check 100 --norms -v + MPI ${mpi} + OMP ${omp} + ) + ecbuild_add_test( TARGET ectrans_lam_test_benchmark_${prec}_${nlon}x${nlat}_mpi${mpi}_omp${omp}_nfld10_nlev20_vordiv_uvders + COMMAND ectrans-lam-benchmark-cpu-${prec} ARGS --nlon ${nlon} --nlat ${nlat} --niter 2 --nfld 10 --nlev 20 --vordiv --uvders --check 100 --norms -v + MPI ${mpi} + OMP ${omp} + ) + ecbuild_add_test( TARGET ectrans_lam_test_benchmark_${prec}_${nlon}x${nlat}_mpi${mpi}_omp${omp}_nfld10_nlev20_nproma16 + COMMAND ectrans-lam-benchmark-cpu-${prec} ARGS --nlon ${nlon} --nlat ${nlat} --niter 2 --nfld 10 --nlev 20 --nproma 16 --check 100 --norms -v + MPI ${mpi} + OMP ${omp} + ) + endforeach() + endforeach() + endif() + endforeach() + + endif() + endif() if( HAVE_TRANSI ) From f821b09f7b253e7ad15b1369b61a330ed37995b4 Mon Sep 17 00:00:00 2001 From: Daan Degrauwe Date: Tue, 3 Dec 2024 13:58:33 +0000 Subject: [PATCH 15/25] added license information to etrans sources --- src/etrans/cpu/biper/external/etibihie.F90 | 11 +++++++++++ src/etrans/cpu/biper/external/fpbipere.F90 | 11 +++++++++++ src/etrans/cpu/biper/external/horiz_field.F90 | 11 +++++++++++ src/etrans/cpu/biper/internal/esmoothe_mod.F90 | 11 +++++++++++ src/etrans/cpu/biper/internal/espline_mod.F90 | 11 +++++++++++ src/etrans/cpu/biper/internal/ewindowe_mod.F90 | 11 +++++++++++ src/etrans/cpu/biper/internal/extper_mod.F90 | 11 +++++++++++ src/etrans/cpu/external/edir_trans.F90 | 11 +++++++++++ src/etrans/cpu/external/edir_transad.F90 | 11 +++++++++++ src/etrans/cpu/external/edist_grid.F90 | 11 +++++++++++ src/etrans/cpu/external/edist_spec.F90 | 11 +++++++++++ src/etrans/cpu/external/egath_grid.F90 | 11 +++++++++++ src/etrans/cpu/external/egath_spec.F90 | 11 +++++++++++ src/etrans/cpu/external/egpnorm_trans.F90 | 11 +++++++++++ src/etrans/cpu/external/einv_trans.F90 | 11 +++++++++++ src/etrans/cpu/external/einv_transad.F90 | 11 +++++++++++ src/etrans/cpu/external/esetup_trans.F90 | 11 +++++++++++ src/etrans/cpu/external/especnorm.F90 | 11 +++++++++++ src/etrans/cpu/external/etrans_end.F90 | 11 +++++++++++ src/etrans/cpu/external/etrans_inq.F90 | 11 +++++++++++ src/etrans/cpu/external/etrans_release.F90 | 11 +++++++++++ src/etrans/cpu/internal/cpl_int_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/easre1ad_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/easre1b_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/easre1bad_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/edealloc_resol_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/edir_trans_ctl_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/edir_trans_ctlad_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/edist_spec_control_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/efsc_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/efscad_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/eftdir_ctl_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/eftdir_ctlad_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/eftdirad_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/eftinv_ctl_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/eftinv_ctlad_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/eftinvad_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/egath_spec_control_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/einv_trans_ctl_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/einv_trans_ctlad_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/eledir_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/eledirad_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/eleinv_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/eleinvad_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/ellips.F90 | 11 +++++++++++ src/etrans/cpu/internal/eltdir_ctl_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/eltdir_ctlad_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/eltdir_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/eltdirad_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/eltinv_ctl_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/eltinv_ctlad_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/eltinv_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/eltinvad_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/eprfi1_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/eprfi1ad_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/eprfi1b_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/eprfi1bad_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/eprfi2_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/eprfi2ad_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/eprfi2b_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/eprfi2bad_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/eset_resol_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/esetup_dims_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/esetup_geom_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/espnorm_ctl_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/espnormc_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/espnormd_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/espnsde_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/espnsdead_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/eupdsp_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/eupdspad_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/eupdspb_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/eupdspbad_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/euvtvd_comm_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/euvtvd_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/euvtvdad_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/evdtuv_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/evdtuvad_comm_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/evdtuvad_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/suefft_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/suemp_trans_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/suemp_trans_preleg_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/suemplat_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/suemplatb_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/suestaonl_mod.F90 | 11 +++++++++++ src/etrans/cpu/internal/tpmald_dim.F90 | 11 +++++++++++ src/etrans/cpu/internal/tpmald_distr.F90 | 11 +++++++++++ src/etrans/cpu/internal/tpmald_fft.F90 | 11 +++++++++++ src/etrans/cpu/internal/tpmald_fields.F90 | 11 +++++++++++ src/etrans/cpu/internal/tpmald_geo.F90 | 11 +++++++++++ src/etrans/cpu/internal/tpmald_tcdis.F90 | 11 +++++++++++ src/etrans/include/etrans/edir_trans.h | 11 +++++++++++ src/etrans/include/etrans/edir_transad.h | 11 +++++++++++ src/etrans/include/etrans/edist_grid.h | 11 +++++++++++ src/etrans/include/etrans/edist_spec.h | 11 +++++++++++ src/etrans/include/etrans/egath_grid.h | 11 +++++++++++ src/etrans/include/etrans/egath_spec.h | 11 +++++++++++ src/etrans/include/etrans/egpnorm_trans.h | 11 +++++++++++ src/etrans/include/etrans/einv_trans.h | 11 +++++++++++ src/etrans/include/etrans/einv_transad.h | 11 +++++++++++ src/etrans/include/etrans/esetup_trans.h | 11 +++++++++++ src/etrans/include/etrans/especnorm.h | 11 +++++++++++ src/etrans/include/etrans/etibihie.h | 11 +++++++++++ src/etrans/include/etrans/etrans_end.h | 11 +++++++++++ src/etrans/include/etrans/etrans_inq.h | 11 +++++++++++ src/etrans/include/etrans/etrans_release.h | 11 +++++++++++ src/etrans/include/etrans/fpbipere.h | 11 +++++++++++ src/etrans/include/etrans/horiz_field.h | 11 +++++++++++ src/programs/ectrans-lam-benchmark.F90 | 10 ++++++++++ 109 files changed, 1198 insertions(+) diff --git a/src/etrans/cpu/biper/external/etibihie.F90 b/src/etrans/cpu/biper/external/etibihie.F90 index 033adf85d..fed2dbab1 100644 --- a/src/etrans/cpu/biper/external/etibihie.F90 +++ b/src/etrans/cpu/biper/external/etibihie.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + SUBROUTINE ETIBIHIE(KDLON,KDGL,KNUBI,KDLUX,KDGUX,& & KSTART,KDLSM,PGPBI,LDBIX,LDBIY,KDADD) diff --git a/src/etrans/cpu/biper/external/fpbipere.F90 b/src/etrans/cpu/biper/external/fpbipere.F90 index 6395ca9f4..9d3ee313c 100644 --- a/src/etrans/cpu/biper/external/fpbipere.F90 +++ b/src/etrans/cpu/biper/external/fpbipere.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + SUBROUTINE FPBIPERE(KDLUX,KDGUX,KDLON,KDGL,KNUBI,KD1,PGPBI,KDADD,LDZON, & & LDBOYD, KDBOYD, PLBOYD) diff --git a/src/etrans/cpu/biper/external/horiz_field.F90 b/src/etrans/cpu/biper/external/horiz_field.F90 index 0d66345c2..54d13f6a4 100644 --- a/src/etrans/cpu/biper/external/horiz_field.F90 +++ b/src/etrans/cpu/biper/external/horiz_field.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + SUBROUTINE HORIZ_FIELD(KX,KY,PHFIELD) ! purpose : diff --git a/src/etrans/cpu/biper/internal/esmoothe_mod.F90 b/src/etrans/cpu/biper/internal/esmoothe_mod.F90 index 4d65fe998..ee68ea8bf 100644 --- a/src/etrans/cpu/biper/internal/esmoothe_mod.F90 +++ b/src/etrans/cpu/biper/internal/esmoothe_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE ESMOOTHE_MOD CONTAINS SUBROUTINE ESMOOTHE(KDLUN,KDLON,KDGUN,KDGL,KDLUX,KDGUX,KSTART,& diff --git a/src/etrans/cpu/biper/internal/espline_mod.F90 b/src/etrans/cpu/biper/internal/espline_mod.F90 index e44880f19..bfec336e3 100644 --- a/src/etrans/cpu/biper/internal/espline_mod.F90 +++ b/src/etrans/cpu/biper/internal/espline_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE ESPLINE_MOD CONTAINS SUBROUTINE ESPLINE(KDLUN,KDLON,KDGUN,KDGL,KDLUX,KDGUX,KSTART,& diff --git a/src/etrans/cpu/biper/internal/ewindowe_mod.F90 b/src/etrans/cpu/biper/internal/ewindowe_mod.F90 index 8d49a3379..8403865c7 100644 --- a/src/etrans/cpu/biper/internal/ewindowe_mod.F90 +++ b/src/etrans/cpu/biper/internal/ewindowe_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EWINDOWE_MOD CONTAINS diff --git a/src/etrans/cpu/biper/internal/extper_mod.F90 b/src/etrans/cpu/biper/internal/extper_mod.F90 index 8135d8048..48df1d3cb 100644 --- a/src/etrans/cpu/biper/internal/extper_mod.F90 +++ b/src/etrans/cpu/biper/internal/extper_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EXTPER_MOD CONTAINS SUBROUTINE EXTPER(PWORK,KDIM,KPSTA,KPOINTS,KFLDS,KUNITS,& diff --git a/src/etrans/cpu/external/edir_trans.F90 b/src/etrans/cpu/external/edir_trans.F90 index bfebffaf2..d542ca93c 100644 --- a/src/etrans/cpu/external/edir_trans.F90 +++ b/src/etrans/cpu/external/edir_trans.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + SUBROUTINE EDIR_TRANS(PSPVOR,PSPDIV,PSPSCALAR,PSPSC3A,PSPSC3B,PSPSC2,& & KPROMA,KVSETUV,KVSETSC,KRESOL,KVSETSC3A,KVSETSC3B,KVSETSC2,& & PGP,PGPUV,PGP3A,PGP3B,PGP2,PMEANU,PMEANV,AUX_PROC) diff --git a/src/etrans/cpu/external/edir_transad.F90 b/src/etrans/cpu/external/edir_transad.F90 index beac97c90..db2913a56 100644 --- a/src/etrans/cpu/external/edir_transad.F90 +++ b/src/etrans/cpu/external/edir_transad.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + SUBROUTINE EDIR_TRANSAD(PSPVOR,PSPDIV,PSPSCALAR,PSPSC3A,PSPSC3B,PSPSC2,& & KPROMA,KVSETUV,KVSETSC,KRESOL,KVSETSC3A,KVSETSC3B,KVSETSC2,& & PGP,PGPUV,PGP3A,PGP3B,PGP2,PMEANU,PMEANV) diff --git a/src/etrans/cpu/external/edist_grid.F90 b/src/etrans/cpu/external/edist_grid.F90 index 78559288b..85d488a32 100644 --- a/src/etrans/cpu/external/edist_grid.F90 +++ b/src/etrans/cpu/external/edist_grid.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + SUBROUTINE EDIST_GRID(PGPG,KPROMA,KFDISTG,KFROM,KRESOL,PGP,KSORT) !**** *EDIST_GRID* - Distribute global gridpoint array among processors diff --git a/src/etrans/cpu/external/edist_spec.F90 b/src/etrans/cpu/external/edist_spec.F90 index eeaa512ce..8aadb6a77 100644 --- a/src/etrans/cpu/external/edist_spec.F90 +++ b/src/etrans/cpu/external/edist_spec.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + SUBROUTINE EDIST_SPEC(PSPECG,KFDISTG,KFROM,KVSET,KRESOL,PSPEC,& & LDIM1_IS_FLD,KSORT) diff --git a/src/etrans/cpu/external/egath_grid.F90 b/src/etrans/cpu/external/egath_grid.F90 index 05455b522..2f713e5b8 100644 --- a/src/etrans/cpu/external/egath_grid.F90 +++ b/src/etrans/cpu/external/egath_grid.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + SUBROUTINE EGATH_GRID(PGPG,KPROMA,KFGATHG,KTO,KRESOL,PGP) !**** *EGATH_GRID* - Gather global gridpoint array from processors diff --git a/src/etrans/cpu/external/egath_spec.F90 b/src/etrans/cpu/external/egath_spec.F90 index 4b2bde0c3..75dc8ede2 100644 --- a/src/etrans/cpu/external/egath_spec.F90 +++ b/src/etrans/cpu/external/egath_spec.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + SUBROUTINE EGATH_SPEC(PSPECG,KFGATHG,KTO,KVSET,KRESOL,PSPEC,LDIM1_IS_FLD,KSMAX,KMSMAX,LDZA0IP) !**** *EGATH_SPEC* - Gather global spectral array from processors diff --git a/src/etrans/cpu/external/egpnorm_trans.F90 b/src/etrans/cpu/external/egpnorm_trans.F90 index bbbf462ae..9d2986b8d 100644 --- a/src/etrans/cpu/external/egpnorm_trans.F90 +++ b/src/etrans/cpu/external/egpnorm_trans.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + SUBROUTINE EGPNORM_TRANS(PGP,KFIELDS,KPROMA,PAVE,PMIN,PMAX,LDAVE_ONLY,KRESOL) diff --git a/src/etrans/cpu/external/einv_trans.F90 b/src/etrans/cpu/external/einv_trans.F90 index 25f47c07a..2b0225671 100644 --- a/src/etrans/cpu/external/einv_trans.F90 +++ b/src/etrans/cpu/external/einv_trans.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + SUBROUTINE EINV_TRANS(PSPVOR,PSPDIV,PSPSCALAR,PSPSC3A,PSPSC3B,PSPSC2,& & FSPGL_PROC,& & LDSCDERS,LDVORGP,LDDIVGP,LDUVDER,KPROMA,KVSETUV,KVSETSC,KRESOL,& diff --git a/src/etrans/cpu/external/einv_transad.F90 b/src/etrans/cpu/external/einv_transad.F90 index 0f38dd37e..3afd66432 100644 --- a/src/etrans/cpu/external/einv_transad.F90 +++ b/src/etrans/cpu/external/einv_transad.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + SUBROUTINE EINV_TRANSAD(PSPVOR,PSPDIV,PSPSCALAR,PSPSC3A,PSPSC3B,PSPSC2,& & FSPGL_PROC,& & LDSCDERS,LDVORGP,LDDIVGP,LDUVDER,KPROMA,KVSETUV,KVSETSC,KRESOL,& diff --git a/src/etrans/cpu/external/esetup_trans.F90 b/src/etrans/cpu/external/esetup_trans.F90 index f1bc92378..72d1aa7e3 100644 --- a/src/etrans/cpu/external/esetup_trans.F90 +++ b/src/etrans/cpu/external/esetup_trans.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + SUBROUTINE ESETUP_TRANS(KMSMAX,KSMAX,KDGL,KDGUX,KLOEN,LDSPLIT,& & KTMAX,KRESOL,PEXWN,PEYWN,PWEIGHT,LDGRIDONLY,KNOEXTZL,KNOEXTZG, & & LDUSEFFTW,LD_ALL_FFTW) diff --git a/src/etrans/cpu/external/especnorm.F90 b/src/etrans/cpu/external/especnorm.F90 index f816ee4c0..6a40ad4f4 100644 --- a/src/etrans/cpu/external/especnorm.F90 +++ b/src/etrans/cpu/external/especnorm.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + SUBROUTINE ESPECNORM(PSPEC,KVSET,KMASTER,KRESOL,PMET,PNORM) !**** *ESPECNORM* - Compute global spectral norms diff --git a/src/etrans/cpu/external/etrans_end.F90 b/src/etrans/cpu/external/etrans_end.F90 index e93a1845e..001a4a67b 100644 --- a/src/etrans/cpu/external/etrans_end.F90 +++ b/src/etrans/cpu/external/etrans_end.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + SUBROUTINE ETRANS_END(CDMODE) !**** *ETRANS_END* - Terminate transform package diff --git a/src/etrans/cpu/external/etrans_inq.F90 b/src/etrans/cpu/external/etrans_inq.F90 index 1d580d60f..7b2ad7013 100644 --- a/src/etrans/cpu/external/etrans_inq.F90 +++ b/src/etrans/cpu/external/etrans_inq.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + SUBROUTINE ETRANS_INQ(KRESOL,KSPEC,KSPEC2,KSPEC2G,KSPEC2MX,KNUMP,& & KGPTOT,KGPTOTG,KGPTOTMX,KGPTOTL,& & KMYMS,KESM0,KUMPP,KPOSSP,KPTRMS,KALLMS,KDIM0G,& diff --git a/src/etrans/cpu/external/etrans_release.F90 b/src/etrans/cpu/external/etrans_release.F90 index ea4f5a8a2..ce60067e7 100644 --- a/src/etrans/cpu/external/etrans_release.F90 +++ b/src/etrans/cpu/external/etrans_release.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + SUBROUTINE ETRANS_RELEASE(KRESOL) !**** *ETRANS_RELEASE* - release a spectral resolution diff --git a/src/etrans/cpu/internal/cpl_int_mod.F90 b/src/etrans/cpu/internal/cpl_int_mod.F90 index 2b55a5b22..476ebb7dd 100644 --- a/src/etrans/cpu/internal/cpl_int_mod.F90 +++ b/src/etrans/cpu/internal/cpl_int_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE CPL_INT_MOD CONTAINS SUBROUTINE CPL_INT(PGTF,KENDROWL,KFIELDS,KFFIELDS,KLEN,KSTA,CPL_PROC,KPTRGP) diff --git a/src/etrans/cpu/internal/easre1ad_mod.F90 b/src/etrans/cpu/internal/easre1ad_mod.F90 index b382d7836..ef0dc66c6 100644 --- a/src/etrans/cpu/internal/easre1ad_mod.F90 +++ b/src/etrans/cpu/internal/easre1ad_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EASRE1AD_MOD CONTAINS SUBROUTINE EASRE1AD(KM,KMLOC,KF_OUT_LT,PIA) diff --git a/src/etrans/cpu/internal/easre1b_mod.F90 b/src/etrans/cpu/internal/easre1b_mod.F90 index cae14b396..5cced838a 100644 --- a/src/etrans/cpu/internal/easre1b_mod.F90 +++ b/src/etrans/cpu/internal/easre1b_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EASRE1B_MOD CONTAINS SUBROUTINE EASRE1B(KFC,KM,KMLOC,PIA) diff --git a/src/etrans/cpu/internal/easre1bad_mod.F90 b/src/etrans/cpu/internal/easre1bad_mod.F90 index 0aa6f3435..2299f1040 100644 --- a/src/etrans/cpu/internal/easre1bad_mod.F90 +++ b/src/etrans/cpu/internal/easre1bad_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EASRE1BAD_MOD CONTAINS SUBROUTINE EASRE1BAD(KFC,KM,KMLOC,PIA) diff --git a/src/etrans/cpu/internal/edealloc_resol_mod.F90 b/src/etrans/cpu/internal/edealloc_resol_mod.F90 index 0864d97b8..0c4546401 100644 --- a/src/etrans/cpu/internal/edealloc_resol_mod.F90 +++ b/src/etrans/cpu/internal/edealloc_resol_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EDEALLOC_RESOL_MOD CONTAINS SUBROUTINE EDEALLOC_RESOL(KRESOL) diff --git a/src/etrans/cpu/internal/edir_trans_ctl_mod.F90 b/src/etrans/cpu/internal/edir_trans_ctl_mod.F90 index 34c6db0c5..ece17b24e 100644 --- a/src/etrans/cpu/internal/edir_trans_ctl_mod.F90 +++ b/src/etrans/cpu/internal/edir_trans_ctl_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EDIR_TRANS_CTL_MOD CONTAINS SUBROUTINE EDIR_TRANS_CTL(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS,KF_UV,KF_SCALARS,& diff --git a/src/etrans/cpu/internal/edir_trans_ctlad_mod.F90 b/src/etrans/cpu/internal/edir_trans_ctlad_mod.F90 index 34de8eed4..b95d45828 100644 --- a/src/etrans/cpu/internal/edir_trans_ctlad_mod.F90 +++ b/src/etrans/cpu/internal/edir_trans_ctlad_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EDIR_TRANS_CTLAD_MOD CONTAINS SUBROUTINE EDIR_TRANS_CTLAD(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS,KF_UV,KF_SCALARS,& diff --git a/src/etrans/cpu/internal/edist_spec_control_mod.F90 b/src/etrans/cpu/internal/edist_spec_control_mod.F90 index ce55ba949..23ae29d7c 100644 --- a/src/etrans/cpu/internal/edist_spec_control_mod.F90 +++ b/src/etrans/cpu/internal/edist_spec_control_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EDIST_SPEC_CONTROL_MOD ! dead code - merged with DIST_SPEC_CONTROL_MOD END MODULE EDIST_SPEC_CONTROL_MOD diff --git a/src/etrans/cpu/internal/efsc_mod.F90 b/src/etrans/cpu/internal/efsc_mod.F90 index 77ab4716e..a34f7644d 100644 --- a/src/etrans/cpu/internal/efsc_mod.F90 +++ b/src/etrans/cpu/internal/efsc_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EFSC_MOD CONTAINS SUBROUTINE EFSC(KGL,KF_UV,KF_SCALARS,KF_SCDERS,& diff --git a/src/etrans/cpu/internal/efscad_mod.F90 b/src/etrans/cpu/internal/efscad_mod.F90 index 4b335f4fa..2981bae04 100644 --- a/src/etrans/cpu/internal/efscad_mod.F90 +++ b/src/etrans/cpu/internal/efscad_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EFSCAD_MOD CONTAINS SUBROUTINE EFSCAD(KGL,KF_UV,KF_SCALARS,KF_SCDERS,& diff --git a/src/etrans/cpu/internal/eftdir_ctl_mod.F90 b/src/etrans/cpu/internal/eftdir_ctl_mod.F90 index 212bcc956..44a8bffce 100644 --- a/src/etrans/cpu/internal/eftdir_ctl_mod.F90 +++ b/src/etrans/cpu/internal/eftdir_ctl_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EFTDIR_CTL_MOD CONTAINS SUBROUTINE EFTDIR_CTL(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS,KF_GPB, & diff --git a/src/etrans/cpu/internal/eftdir_ctlad_mod.F90 b/src/etrans/cpu/internal/eftdir_ctlad_mod.F90 index 09483e0a4..6c4d4d59c 100644 --- a/src/etrans/cpu/internal/eftdir_ctlad_mod.F90 +++ b/src/etrans/cpu/internal/eftdir_ctlad_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EFTDIR_CTLAD_MOD CONTAINS SUBROUTINE EFTDIR_CTLAD(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS,KF_GPB, & diff --git a/src/etrans/cpu/internal/eftdirad_mod.F90 b/src/etrans/cpu/internal/eftdirad_mod.F90 index 4790b6b8b..d3cb36349 100644 --- a/src/etrans/cpu/internal/eftdirad_mod.F90 +++ b/src/etrans/cpu/internal/eftdirad_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EFTDIRAD_MOD CONTAINS SUBROUTINE EFTDIRAD(PREEL,KFIELDS,KGL) diff --git a/src/etrans/cpu/internal/eftinv_ctl_mod.F90 b/src/etrans/cpu/internal/eftinv_ctl_mod.F90 index 3dd9d5352..70c747003 100644 --- a/src/etrans/cpu/internal/eftinv_ctl_mod.F90 +++ b/src/etrans/cpu/internal/eftinv_ctl_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EFTINV_CTL_MOD CONTAINS SUBROUTINE EFTINV_CTL(KF_UV_G,KF_SCALARS_G,& diff --git a/src/etrans/cpu/internal/eftinv_ctlad_mod.F90 b/src/etrans/cpu/internal/eftinv_ctlad_mod.F90 index fd1fc5e57..f62784ee9 100644 --- a/src/etrans/cpu/internal/eftinv_ctlad_mod.F90 +++ b/src/etrans/cpu/internal/eftinv_ctlad_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EFTINV_CTLAD_MOD CONTAINS SUBROUTINE EFTINV_CTLAD(KF_UV_G,KF_SCALARS_G,& diff --git a/src/etrans/cpu/internal/eftinvad_mod.F90 b/src/etrans/cpu/internal/eftinvad_mod.F90 index 0c0ebcac6..606ded25f 100644 --- a/src/etrans/cpu/internal/eftinvad_mod.F90 +++ b/src/etrans/cpu/internal/eftinvad_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EFTINVAD_MOD CONTAINS SUBROUTINE EFTINVAD(PREEL,KFIELDS,KGL) diff --git a/src/etrans/cpu/internal/egath_spec_control_mod.F90 b/src/etrans/cpu/internal/egath_spec_control_mod.F90 index c67b315aa..c2ec2e256 100644 --- a/src/etrans/cpu/internal/egath_spec_control_mod.F90 +++ b/src/etrans/cpu/internal/egath_spec_control_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EGATH_SPEC_CONTROL_MOD CONTAINS SUBROUTINE EGATH_SPEC_CONTROL(PSPECG,KFGATHG,KTO,KVSET,PSPEC,LDIM1_IS_FLD,& diff --git a/src/etrans/cpu/internal/einv_trans_ctl_mod.F90 b/src/etrans/cpu/internal/einv_trans_ctl_mod.F90 index fde4b8019..56ad491a1 100644 --- a/src/etrans/cpu/internal/einv_trans_ctl_mod.F90 +++ b/src/etrans/cpu/internal/einv_trans_ctl_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EINV_TRANS_CTL_MOD CONTAINS SUBROUTINE EINV_TRANS_CTL(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS,KF_OUT_LT,& diff --git a/src/etrans/cpu/internal/einv_trans_ctlad_mod.F90 b/src/etrans/cpu/internal/einv_trans_ctlad_mod.F90 index aa00708c2..68b35001b 100644 --- a/src/etrans/cpu/internal/einv_trans_ctlad_mod.F90 +++ b/src/etrans/cpu/internal/einv_trans_ctlad_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EINV_TRANS_CTLAD_MOD CONTAINS SUBROUTINE EINV_TRANS_CTLAD(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS,KF_OUT_LT,& diff --git a/src/etrans/cpu/internal/eledir_mod.F90 b/src/etrans/cpu/internal/eledir_mod.F90 index 8f5f5ac83..ae9596edd 100644 --- a/src/etrans/cpu/internal/eledir_mod.F90 +++ b/src/etrans/cpu/internal/eledir_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE ELEDIR_MOD CONTAINS SUBROUTINE ELEDIR(KM,KFC,KLED2,PFFT) diff --git a/src/etrans/cpu/internal/eledirad_mod.F90 b/src/etrans/cpu/internal/eledirad_mod.F90 index 7d37b9c63..738dc4b75 100644 --- a/src/etrans/cpu/internal/eledirad_mod.F90 +++ b/src/etrans/cpu/internal/eledirad_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE ELEDIRAD_MOD CONTAINS SUBROUTINE ELEDIRAD(KM,KFC,KLED2,PFFT) diff --git a/src/etrans/cpu/internal/eleinv_mod.F90 b/src/etrans/cpu/internal/eleinv_mod.F90 index a830c6353..082acedab 100644 --- a/src/etrans/cpu/internal/eleinv_mod.F90 +++ b/src/etrans/cpu/internal/eleinv_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE ELEINV_MOD CONTAINS SUBROUTINE ELEINV(KM,KFC,KF_OUT_LT,PIA) diff --git a/src/etrans/cpu/internal/eleinvad_mod.F90 b/src/etrans/cpu/internal/eleinvad_mod.F90 index 6a0a02e85..04f5cfb1c 100644 --- a/src/etrans/cpu/internal/eleinvad_mod.F90 +++ b/src/etrans/cpu/internal/eleinvad_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE ELEINVAD_MOD CONTAINS SUBROUTINE ELEINVAD(KM,KFC,KF_OUT_LT,PIA) diff --git a/src/etrans/cpu/internal/ellips.F90 b/src/etrans/cpu/internal/ellips.F90 index 63c73249e..55682502d 100644 --- a/src/etrans/cpu/internal/ellips.F90 +++ b/src/etrans/cpu/internal/ellips.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + ! Jan-2011 P. Marguinaud Interface to thread-safe FA SUBROUTINE ELLIPS (KSMAX,KMSMAX,KNTMP,KMTMP) USE PARKIND1, ONLY : JPRD, JPIM diff --git a/src/etrans/cpu/internal/eltdir_ctl_mod.F90 b/src/etrans/cpu/internal/eltdir_ctl_mod.F90 index 5b38cb74e..97796a36c 100644 --- a/src/etrans/cpu/internal/eltdir_ctl_mod.F90 +++ b/src/etrans/cpu/internal/eltdir_ctl_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE ELTDIR_CTL_MOD CONTAINS SUBROUTINE ELTDIR_CTL(KF_FS,KF_UV,KF_SCALARS, & diff --git a/src/etrans/cpu/internal/eltdir_ctlad_mod.F90 b/src/etrans/cpu/internal/eltdir_ctlad_mod.F90 index 3433e8ca4..ea19442f7 100644 --- a/src/etrans/cpu/internal/eltdir_ctlad_mod.F90 +++ b/src/etrans/cpu/internal/eltdir_ctlad_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE ELTDIR_CTLAD_MOD CONTAINS SUBROUTINE ELTDIR_CTLAD(KF_FS,KF_UV,KF_SCALARS, & diff --git a/src/etrans/cpu/internal/eltdir_mod.F90 b/src/etrans/cpu/internal/eltdir_mod.F90 index 01a9a1ec8..89932a7eb 100644 --- a/src/etrans/cpu/internal/eltdir_mod.F90 +++ b/src/etrans/cpu/internal/eltdir_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE ELTDIR_MOD CONTAINS SUBROUTINE ELTDIR(KM,KMLOC,KF_FS,KF_UV,KF_SCALARS,KLED2,& diff --git a/src/etrans/cpu/internal/eltdirad_mod.F90 b/src/etrans/cpu/internal/eltdirad_mod.F90 index fd11df013..fc8457faf 100644 --- a/src/etrans/cpu/internal/eltdirad_mod.F90 +++ b/src/etrans/cpu/internal/eltdirad_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE ELTDIRAD_MOD CONTAINS SUBROUTINE ELTDIRAD(KM,KMLOC,KF_FS,KF_UV,KF_SCALARS,KLED2,& diff --git a/src/etrans/cpu/internal/eltinv_ctl_mod.F90 b/src/etrans/cpu/internal/eltinv_ctl_mod.F90 index dea5b7b6e..f79ba89b5 100644 --- a/src/etrans/cpu/internal/eltinv_ctl_mod.F90 +++ b/src/etrans/cpu/internal/eltinv_ctl_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE ELTINV_CTL_MOD CONTAINS SUBROUTINE ELTINV_CTL(KF_OUT_LT,KF_UV,KF_SCALARS,KF_SCDERS,& diff --git a/src/etrans/cpu/internal/eltinv_ctlad_mod.F90 b/src/etrans/cpu/internal/eltinv_ctlad_mod.F90 index 43e8f4c4c..8cca104ee 100644 --- a/src/etrans/cpu/internal/eltinv_ctlad_mod.F90 +++ b/src/etrans/cpu/internal/eltinv_ctlad_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE ELTINV_CTLAD_MOD CONTAINS SUBROUTINE ELTINV_CTLAD(KF_OUT_LT,KF_UV,KF_SCALARS,KF_SCDERS,& diff --git a/src/etrans/cpu/internal/eltinv_mod.F90 b/src/etrans/cpu/internal/eltinv_mod.F90 index 524ace889..183d9187e 100644 --- a/src/etrans/cpu/internal/eltinv_mod.F90 +++ b/src/etrans/cpu/internal/eltinv_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE ELTINV_MOD CONTAINS SUBROUTINE ELTINV(KM,KMLOC,KF_OUT_LT,KF_UV,KF_SCALARS,KF_SCDERS,KLEI2,KDIM1,& diff --git a/src/etrans/cpu/internal/eltinvad_mod.F90 b/src/etrans/cpu/internal/eltinvad_mod.F90 index a332b2eb3..fc1d354fb 100644 --- a/src/etrans/cpu/internal/eltinvad_mod.F90 +++ b/src/etrans/cpu/internal/eltinvad_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE ELTINVAD_MOD CONTAINS SUBROUTINE ELTINVAD(KF_OUT_LT,KF_UV,KF_SCALARS,KF_SCDERS,KLEI2,& diff --git a/src/etrans/cpu/internal/eprfi1_mod.F90 b/src/etrans/cpu/internal/eprfi1_mod.F90 index 3e3feca51..afbf9b259 100644 --- a/src/etrans/cpu/internal/eprfi1_mod.F90 +++ b/src/etrans/cpu/internal/eprfi1_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EPRFI1_MOD CONTAINS SUBROUTINE EPRFI1(KM,KF_UV,KF_SCALARS,PIA,PSPVOR,PSPDIV,PSPSCALAR,& diff --git a/src/etrans/cpu/internal/eprfi1ad_mod.F90 b/src/etrans/cpu/internal/eprfi1ad_mod.F90 index ad7cd1725..e89caa9ac 100644 --- a/src/etrans/cpu/internal/eprfi1ad_mod.F90 +++ b/src/etrans/cpu/internal/eprfi1ad_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EPRFI1AD_MOD CONTAINS SUBROUTINE EPRFI1AD(KM,KF_UV,KF_SCALARS,PIA,PSPVOR,PSPDIV,PSPSCALAR,& diff --git a/src/etrans/cpu/internal/eprfi1b_mod.F90 b/src/etrans/cpu/internal/eprfi1b_mod.F90 index 1a64daf29..d0a6d7858 100644 --- a/src/etrans/cpu/internal/eprfi1b_mod.F90 +++ b/src/etrans/cpu/internal/eprfi1b_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EPRFI1B_MOD CONTAINS SUBROUTINE EPRFI1B(KM,PIA,PSPEC,KFIELDS,KFLDPTR) diff --git a/src/etrans/cpu/internal/eprfi1bad_mod.F90 b/src/etrans/cpu/internal/eprfi1bad_mod.F90 index 81a31ea69..e59ccb5ab 100644 --- a/src/etrans/cpu/internal/eprfi1bad_mod.F90 +++ b/src/etrans/cpu/internal/eprfi1bad_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EPRFI1BAD_MOD CONTAINS SUBROUTINE EPRFI1BAD(KM,PIA,PSPEC,KFIELDS,KFLDPTR) diff --git a/src/etrans/cpu/internal/eprfi2_mod.F90 b/src/etrans/cpu/internal/eprfi2_mod.F90 index 35c418bf1..8fa01d25e 100644 --- a/src/etrans/cpu/internal/eprfi2_mod.F90 +++ b/src/etrans/cpu/internal/eprfi2_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EPRFI2_MOD CONTAINS SUBROUTINE EPRFI2(KM,KMLOC,KF_FS,PFFT) diff --git a/src/etrans/cpu/internal/eprfi2ad_mod.F90 b/src/etrans/cpu/internal/eprfi2ad_mod.F90 index 186dc29e4..ccd279f7f 100644 --- a/src/etrans/cpu/internal/eprfi2ad_mod.F90 +++ b/src/etrans/cpu/internal/eprfi2ad_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EPRFI2AD_MOD CONTAINS SUBROUTINE EPRFI2AD(KM,KMLOC,KF_FS,PFFT) diff --git a/src/etrans/cpu/internal/eprfi2b_mod.F90 b/src/etrans/cpu/internal/eprfi2b_mod.F90 index 6c304d81c..0555bed1b 100644 --- a/src/etrans/cpu/internal/eprfi2b_mod.F90 +++ b/src/etrans/cpu/internal/eprfi2b_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EPRFI2B_MOD CONTAINS SUBROUTINE EPRFI2B(KFIELD,KM,KMLOC,PFFT) diff --git a/src/etrans/cpu/internal/eprfi2bad_mod.F90 b/src/etrans/cpu/internal/eprfi2bad_mod.F90 index 40865662b..bf8d38952 100644 --- a/src/etrans/cpu/internal/eprfi2bad_mod.F90 +++ b/src/etrans/cpu/internal/eprfi2bad_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EPRFI2BAD_MOD CONTAINS SUBROUTINE EPRFI2BAD(KFIELD,KM,KMLOC,PFFT) diff --git a/src/etrans/cpu/internal/eset_resol_mod.F90 b/src/etrans/cpu/internal/eset_resol_mod.F90 index 3b77bd002..c76bfc467 100644 --- a/src/etrans/cpu/internal/eset_resol_mod.F90 +++ b/src/etrans/cpu/internal/eset_resol_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE ESET_RESOL_MOD CONTAINS SUBROUTINE ESET_RESOL(KRESOL) diff --git a/src/etrans/cpu/internal/esetup_dims_mod.F90 b/src/etrans/cpu/internal/esetup_dims_mod.F90 index 077f2740f..b5b1a2271 100644 --- a/src/etrans/cpu/internal/esetup_dims_mod.F90 +++ b/src/etrans/cpu/internal/esetup_dims_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE ESETUP_DIMS_MOD CONTAINS SUBROUTINE ESETUP_DIMS diff --git a/src/etrans/cpu/internal/esetup_geom_mod.F90 b/src/etrans/cpu/internal/esetup_geom_mod.F90 index a93c67d24..e61f9b6b9 100644 --- a/src/etrans/cpu/internal/esetup_geom_mod.F90 +++ b/src/etrans/cpu/internal/esetup_geom_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE ESETUP_GEOM_MOD CONTAINS SUBROUTINE ESETUP_GEOM diff --git a/src/etrans/cpu/internal/espnorm_ctl_mod.F90 b/src/etrans/cpu/internal/espnorm_ctl_mod.F90 index 6e0ad3aae..163059ff0 100644 --- a/src/etrans/cpu/internal/espnorm_ctl_mod.F90 +++ b/src/etrans/cpu/internal/espnorm_ctl_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE ESPNORM_CTL_MOD CONTAINS SUBROUTINE ESPNORM_CTL(PSPEC,KFLD,KFLD_G,KVSET,KMASTER,PMET,PNORM) diff --git a/src/etrans/cpu/internal/espnormc_mod.F90 b/src/etrans/cpu/internal/espnormc_mod.F90 index 4b56285f6..f802ac553 100644 --- a/src/etrans/cpu/internal/espnormc_mod.F90 +++ b/src/etrans/cpu/internal/espnormc_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE ESPNORMC_MOD ! dead code END MODULE ESPNORMC_MOD diff --git a/src/etrans/cpu/internal/espnormd_mod.F90 b/src/etrans/cpu/internal/espnormd_mod.F90 index 75e245add..a17b11698 100644 --- a/src/etrans/cpu/internal/espnormd_mod.F90 +++ b/src/etrans/cpu/internal/espnormd_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE ESPNORMD_MOD CONTAINS SUBROUTINE ESPNORMD(PSPEC,KFLD,PMET,PSM) diff --git a/src/etrans/cpu/internal/espnsde_mod.F90 b/src/etrans/cpu/internal/espnsde_mod.F90 index 9160e61ce..48918d755 100644 --- a/src/etrans/cpu/internal/espnsde_mod.F90 +++ b/src/etrans/cpu/internal/espnsde_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE ESPNSDE_MOD CONTAINS SUBROUTINE ESPNSDE(KM,KF_SCALARS,PF,PNSD) diff --git a/src/etrans/cpu/internal/espnsdead_mod.F90 b/src/etrans/cpu/internal/espnsdead_mod.F90 index 3ca9ded9c..66fabc53a 100644 --- a/src/etrans/cpu/internal/espnsdead_mod.F90 +++ b/src/etrans/cpu/internal/espnsdead_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE ESPNSDEAD_MOD CONTAINS SUBROUTINE ESPNSDEAD(KM,KF_SCALARS,PF,PNSD) diff --git a/src/etrans/cpu/internal/eupdsp_mod.F90 b/src/etrans/cpu/internal/eupdsp_mod.F90 index 210ac4fc5..ee336eee0 100644 --- a/src/etrans/cpu/internal/eupdsp_mod.F90 +++ b/src/etrans/cpu/internal/eupdsp_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EUPDSP_MOD CONTAINS SUBROUTINE EUPDSP(KM,KF_UV,KF_SCALARS,PFFT,PVODI, & diff --git a/src/etrans/cpu/internal/eupdspad_mod.F90 b/src/etrans/cpu/internal/eupdspad_mod.F90 index 8f1699a1a..9f50dea0d 100644 --- a/src/etrans/cpu/internal/eupdspad_mod.F90 +++ b/src/etrans/cpu/internal/eupdspad_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EUPDSPAD_MOD CONTAINS SUBROUTINE EUPDSPAD(KM,KF_UV,KF_SCALARS,PFFT,PVODI, & diff --git a/src/etrans/cpu/internal/eupdspb_mod.F90 b/src/etrans/cpu/internal/eupdspb_mod.F90 index 37601c8f2..17c0be09b 100644 --- a/src/etrans/cpu/internal/eupdspb_mod.F90 +++ b/src/etrans/cpu/internal/eupdspb_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EUPDSPB_MOD CONTAINS SUBROUTINE EUPDSPB(KM,KFIELD,POA,PSPEC,KFLDPTR) diff --git a/src/etrans/cpu/internal/eupdspbad_mod.F90 b/src/etrans/cpu/internal/eupdspbad_mod.F90 index 894f00260..8f85b2846 100644 --- a/src/etrans/cpu/internal/eupdspbad_mod.F90 +++ b/src/etrans/cpu/internal/eupdspbad_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EUPDSPBAD_MOD CONTAINS SUBROUTINE EUPDSPBAD(KM,KFIELD,POA,PSPEC,KFLDPTR) diff --git a/src/etrans/cpu/internal/euvtvd_comm_mod.F90 b/src/etrans/cpu/internal/euvtvd_comm_mod.F90 index 44fa1fe02..14c2b0091 100644 --- a/src/etrans/cpu/internal/euvtvd_comm_mod.F90 +++ b/src/etrans/cpu/internal/euvtvd_comm_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EUVTVD_COMM_MOD CONTAINS SUBROUTINE EUVTVD_COMM(KFIELD,PSPMEANU,PSPMEANV,KFLDPTR) diff --git a/src/etrans/cpu/internal/euvtvd_mod.F90 b/src/etrans/cpu/internal/euvtvd_mod.F90 index 38d918d16..4d8895d39 100644 --- a/src/etrans/cpu/internal/euvtvd_mod.F90 +++ b/src/etrans/cpu/internal/euvtvd_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EUVTVD_MOD CONTAINS SUBROUTINE EUVTVD(KM,KMLOC,KFIELD,PU,PV,PVOR,PDIV) diff --git a/src/etrans/cpu/internal/euvtvdad_mod.F90 b/src/etrans/cpu/internal/euvtvdad_mod.F90 index 8b72f9932..e6a36eac3 100644 --- a/src/etrans/cpu/internal/euvtvdad_mod.F90 +++ b/src/etrans/cpu/internal/euvtvdad_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EUVTVDAD_MOD CONTAINS SUBROUTINE EUVTVDAD(KM,KMLOC,KFIELD,KFLDPTR,PU,PV,PVOR,PDIV,PSPMEANU,PSPMEANV) diff --git a/src/etrans/cpu/internal/evdtuv_mod.F90 b/src/etrans/cpu/internal/evdtuv_mod.F90 index 33f9f4e8b..184d6cb2b 100644 --- a/src/etrans/cpu/internal/evdtuv_mod.F90 +++ b/src/etrans/cpu/internal/evdtuv_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EVDTUV_MOD CONTAINS SUBROUTINE EVDTUV(KM,KFIELD,KFLDPTR,PVOR,PDIV,PU,PV,PSPMEANU,PSPMEANV) diff --git a/src/etrans/cpu/internal/evdtuvad_comm_mod.F90 b/src/etrans/cpu/internal/evdtuvad_comm_mod.F90 index 492a01bbc..63fd32814 100644 --- a/src/etrans/cpu/internal/evdtuvad_comm_mod.F90 +++ b/src/etrans/cpu/internal/evdtuvad_comm_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EVDTUVAD_COMM_MOD CONTAINS SUBROUTINE EVDTUVAD_COMM(KM,KMLOC,KFIELD,KFLDPTR,PSPMEANU,PSPMEANV) diff --git a/src/etrans/cpu/internal/evdtuvad_mod.F90 b/src/etrans/cpu/internal/evdtuvad_mod.F90 index a34135fcb..e0a8a2749 100644 --- a/src/etrans/cpu/internal/evdtuvad_mod.F90 +++ b/src/etrans/cpu/internal/evdtuvad_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE EVDTUVAD_MOD CONTAINS SUBROUTINE EVDTUVAD(KM,KMLOC,KFIELD,KFLDPTR,PVOR,PDIV,PU,PV,PSPMEANU,PSPMEANV) diff --git a/src/etrans/cpu/internal/suefft_mod.F90 b/src/etrans/cpu/internal/suefft_mod.F90 index 9db770469..670b38d52 100644 --- a/src/etrans/cpu/internal/suefft_mod.F90 +++ b/src/etrans/cpu/internal/suefft_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE SUEFFT_MOD CONTAINS SUBROUTINE SUEFFT diff --git a/src/etrans/cpu/internal/suemp_trans_mod.F90 b/src/etrans/cpu/internal/suemp_trans_mod.F90 index 4a1328cd1..17bb28870 100644 --- a/src/etrans/cpu/internal/suemp_trans_mod.F90 +++ b/src/etrans/cpu/internal/suemp_trans_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE SUEMP_TRANS_MOD CONTAINS SUBROUTINE SUEMP_TRANS diff --git a/src/etrans/cpu/internal/suemp_trans_preleg_mod.F90 b/src/etrans/cpu/internal/suemp_trans_preleg_mod.F90 index 34f3fb7cd..9ab000f16 100644 --- a/src/etrans/cpu/internal/suemp_trans_preleg_mod.F90 +++ b/src/etrans/cpu/internal/suemp_trans_preleg_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE SUEMP_TRANS_PRELEG_MOD CONTAINS SUBROUTINE SUEMP_TRANS_PRELEG diff --git a/src/etrans/cpu/internal/suemplat_mod.F90 b/src/etrans/cpu/internal/suemplat_mod.F90 index 981497e02..7f1c1393e 100644 --- a/src/etrans/cpu/internal/suemplat_mod.F90 +++ b/src/etrans/cpu/internal/suemplat_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE SUEMPLAT_MOD CONTAINS SUBROUTINE SUEMPLAT(KDGL,KPROC,KPROCA,KMYSETA,LDSPLIT,LDEQ_REGIONS,& diff --git a/src/etrans/cpu/internal/suemplatb_mod.F90 b/src/etrans/cpu/internal/suemplatb_mod.F90 index 94ca0287f..66c275599 100644 --- a/src/etrans/cpu/internal/suemplatb_mod.F90 +++ b/src/etrans/cpu/internal/suemplatb_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE SUEMPLATB_MOD CONTAINS SUBROUTINE SUEMPLATB(KDGSA,KDGL,KPROCA,KLOENG,LDSPLIT,& diff --git a/src/etrans/cpu/internal/suestaonl_mod.F90 b/src/etrans/cpu/internal/suestaonl_mod.F90 index f32fea14b..e69dcd946 100644 --- a/src/etrans/cpu/internal/suestaonl_mod.F90 +++ b/src/etrans/cpu/internal/suestaonl_mod.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE SUESTAONL_MOD CONTAINS SUBROUTINE SUESTAONL(KMEDIAP,KRESTM,LDWEIGHTED_DISTR,PWEIGHT,PMEDIAP,KPROCAGP) diff --git a/src/etrans/cpu/internal/tpmald_dim.F90 b/src/etrans/cpu/internal/tpmald_dim.F90 index 716334232..188f6ebc6 100644 --- a/src/etrans/cpu/internal/tpmald_dim.F90 +++ b/src/etrans/cpu/internal/tpmald_dim.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE TPMALD_DIM ! Module for dimensions. diff --git a/src/etrans/cpu/internal/tpmald_distr.F90 b/src/etrans/cpu/internal/tpmald_distr.F90 index 9f358db92..2d9cc0a79 100644 --- a/src/etrans/cpu/internal/tpmald_distr.F90 +++ b/src/etrans/cpu/internal/tpmald_distr.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE TPMALD_DISTR ! Module for distributed memory environment. diff --git a/src/etrans/cpu/internal/tpmald_fft.F90 b/src/etrans/cpu/internal/tpmald_fft.F90 index 004eb04e6..10d7f70fc 100644 --- a/src/etrans/cpu/internal/tpmald_fft.F90 +++ b/src/etrans/cpu/internal/tpmald_fft.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE TPMALD_FFT ! Module for Fourier transforms. diff --git a/src/etrans/cpu/internal/tpmald_fields.F90 b/src/etrans/cpu/internal/tpmald_fields.F90 index 9dfda6db3..0d9cec7de 100644 --- a/src/etrans/cpu/internal/tpmald_fields.F90 +++ b/src/etrans/cpu/internal/tpmald_fields.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE TPMALD_FIELDS USE PARKIND1 ,ONLY : JPIM ,JPRB diff --git a/src/etrans/cpu/internal/tpmald_geo.F90 b/src/etrans/cpu/internal/tpmald_geo.F90 index 326739a16..2f720c8fe 100644 --- a/src/etrans/cpu/internal/tpmald_geo.F90 +++ b/src/etrans/cpu/internal/tpmald_geo.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE TPMALD_GEO ! Module containing data describing plane projection grid. diff --git a/src/etrans/cpu/internal/tpmald_tcdis.F90 b/src/etrans/cpu/internal/tpmald_tcdis.F90 index 2b57ca50b..539677efa 100644 --- a/src/etrans/cpu/internal/tpmald_tcdis.F90 +++ b/src/etrans/cpu/internal/tpmald_tcdis.F90 @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + MODULE TPMALD_TCDIS ! useless diff --git a/src/etrans/include/etrans/edir_trans.h b/src/etrans/include/etrans/edir_trans.h index 6f9721723..6b00892ae 100644 --- a/src/etrans/include/etrans/edir_trans.h +++ b/src/etrans/include/etrans/edir_trans.h @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + INTERFACE SUBROUTINE EDIR_TRANS(PSPVOR,PSPDIV,PSPSCALAR,PSPSC3A,PSPSC3B,PSPSC2,& & KPROMA,KVSETUV,KVSETSC,KRESOL,KVSETSC3A,KVSETSC3B,KVSETSC2,& diff --git a/src/etrans/include/etrans/edir_transad.h b/src/etrans/include/etrans/edir_transad.h index 7dc6fa0d3..7bc4a99f4 100644 --- a/src/etrans/include/etrans/edir_transad.h +++ b/src/etrans/include/etrans/edir_transad.h @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + INTERFACE SUBROUTINE EDIR_TRANSAD(PSPVOR,PSPDIV,PSPSCALAR,PSPSC3A,PSPSC3B,PSPSC2,& & KPROMA,KVSETUV,KVSETSC,KRESOL,KVSETSC3A,KVSETSC3B,KVSETSC2,& diff --git a/src/etrans/include/etrans/edist_grid.h b/src/etrans/include/etrans/edist_grid.h index 92e93aeb7..0bdbd8fb7 100644 --- a/src/etrans/include/etrans/edist_grid.h +++ b/src/etrans/include/etrans/edist_grid.h @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + INTERFACE SUBROUTINE EDIST_GRID(PGPG,KPROMA,KFDISTG,KFROM,KRESOL,PGP,KSORT) diff --git a/src/etrans/include/etrans/edist_spec.h b/src/etrans/include/etrans/edist_spec.h index 43b9b4bcf..11616cd8f 100644 --- a/src/etrans/include/etrans/edist_spec.h +++ b/src/etrans/include/etrans/edist_spec.h @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + INTERFACE SUBROUTINE EDIST_SPEC(PSPECG,KFDISTG,KFROM,KVSET,KRESOL,PSPEC,& & LDIM1_IS_FLD,KSORT) diff --git a/src/etrans/include/etrans/egath_grid.h b/src/etrans/include/etrans/egath_grid.h index a9742c300..be7853cd9 100644 --- a/src/etrans/include/etrans/egath_grid.h +++ b/src/etrans/include/etrans/egath_grid.h @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + INTERFACE SUBROUTINE EGATH_GRID(PGPG,KPROMA,KFGATHG,KTO,KRESOL,PGP) diff --git a/src/etrans/include/etrans/egath_spec.h b/src/etrans/include/etrans/egath_spec.h index 5a2842d0b..e6ba990f6 100644 --- a/src/etrans/include/etrans/egath_spec.h +++ b/src/etrans/include/etrans/egath_spec.h @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + INTERFACE SUBROUTINE EGATH_SPEC(PSPECG,KFGATHG,KTO,KVSET,KRESOL,PSPEC,LDIM1_IS_FLD,KSMAX,KMSMAX,LDZA0IP) diff --git a/src/etrans/include/etrans/egpnorm_trans.h b/src/etrans/include/etrans/egpnorm_trans.h index 8c7fc4e53..9f7523e91 100644 --- a/src/etrans/include/etrans/egpnorm_trans.h +++ b/src/etrans/include/etrans/egpnorm_trans.h @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + INTERFACE SUBROUTINE EGPNORM_TRANS(PGP,KFIELDS,KPROMA,PAVE,PMIN,PMAX,LDAVE_ONLY,KRESOL) diff --git a/src/etrans/include/etrans/einv_trans.h b/src/etrans/include/etrans/einv_trans.h index 143d883b8..5b8be538f 100644 --- a/src/etrans/include/etrans/einv_trans.h +++ b/src/etrans/include/etrans/einv_trans.h @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + INTERFACE SUBROUTINE EINV_TRANS(PSPVOR,PSPDIV,PSPSCALAR,PSPSC3A,PSPSC3B,PSPSC2,& & FSPGL_PROC,& diff --git a/src/etrans/include/etrans/einv_transad.h b/src/etrans/include/etrans/einv_transad.h index 923864915..44bbfb11c 100644 --- a/src/etrans/include/etrans/einv_transad.h +++ b/src/etrans/include/etrans/einv_transad.h @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + INTERFACE SUBROUTINE EINV_TRANSAD(PSPVOR,PSPDIV,PSPSCALAR,PSPSC3A,PSPSC3B,PSPSC2,& & FSPGL_PROC,& diff --git a/src/etrans/include/etrans/esetup_trans.h b/src/etrans/include/etrans/esetup_trans.h index 15c99f17c..48b992dce 100644 --- a/src/etrans/include/etrans/esetup_trans.h +++ b/src/etrans/include/etrans/esetup_trans.h @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + INTERFACE SUBROUTINE ESETUP_TRANS(KMSMAX,KSMAX,KDGL,KDGUX,KLOEN,LDSPLIT,& & KTMAX,KRESOL,PEXWN,PEYWN,PWEIGHT,LDGRIDONLY,KNOEXTZL,KNOEXTZG,& diff --git a/src/etrans/include/etrans/especnorm.h b/src/etrans/include/etrans/especnorm.h index 7edf5d78c..bbc82a264 100644 --- a/src/etrans/include/etrans/especnorm.h +++ b/src/etrans/include/etrans/especnorm.h @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + INTERFACE SUBROUTINE ESPECNORM(PSPEC,KVSET,KMASTER,KRESOL,PMET,PNORM) diff --git a/src/etrans/include/etrans/etibihie.h b/src/etrans/include/etrans/etibihie.h index 53861fb33..b7305f774 100644 --- a/src/etrans/include/etrans/etibihie.h +++ b/src/etrans/include/etrans/etibihie.h @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + INTERFACE SUBROUTINE ETIBIHIE(KDLON,KDGL,KNUBI,KDLUX,KDGUX,& & KSTART,KDLSM,PGPBI,LDBIX,LDBIY,KDADD) diff --git a/src/etrans/include/etrans/etrans_end.h b/src/etrans/include/etrans/etrans_end.h index fb1090fb2..7f6c95eb8 100644 --- a/src/etrans/include/etrans/etrans_end.h +++ b/src/etrans/include/etrans/etrans_end.h @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + INTERFACE SUBROUTINE ETRANS_END(CDMODE) diff --git a/src/etrans/include/etrans/etrans_inq.h b/src/etrans/include/etrans/etrans_inq.h index 04f2e56e7..c7711863d 100644 --- a/src/etrans/include/etrans/etrans_inq.h +++ b/src/etrans/include/etrans/etrans_inq.h @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + INTERFACE SUBROUTINE ETRANS_INQ(KRESOL,KSPEC,KSPEC2,KSPEC2G,KSPEC2MX,KNUMP,& & KGPTOT,KGPTOTG,KGPTOTMX,KGPTOTL,& diff --git a/src/etrans/include/etrans/etrans_release.h b/src/etrans/include/etrans/etrans_release.h index 846424c87..7f92e1e01 100644 --- a/src/etrans/include/etrans/etrans_release.h +++ b/src/etrans/include/etrans/etrans_release.h @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + INTERFACE SUBROUTINE ETRANS_RELEASE(KRESOL) USE PARKIND1 ,ONLY : JPIM diff --git a/src/etrans/include/etrans/fpbipere.h b/src/etrans/include/etrans/fpbipere.h index 16fbc0cd4..c7356501d 100644 --- a/src/etrans/include/etrans/fpbipere.h +++ b/src/etrans/include/etrans/fpbipere.h @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + INTERFACE SUBROUTINE FPBIPERE(KDLUX,KDGUX,KDLON,KDGL,KNUBI,KD1,PGPBI,KDADD,LDZON,& & LDBOYD,KDBOYD,PLBOYD,PBIPOUT) diff --git a/src/etrans/include/etrans/horiz_field.h b/src/etrans/include/etrans/horiz_field.h index 6acb5d64b..293825235 100644 --- a/src/etrans/include/etrans/horiz_field.h +++ b/src/etrans/include/etrans/horiz_field.h @@ -1,3 +1,14 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + + INTERFACE SUBROUTINE HORIZ_FIELD(KX,KY,PHFIELD) diff --git a/src/programs/ectrans-lam-benchmark.F90 b/src/programs/ectrans-lam-benchmark.F90 index 12032a004..bb8201a33 100644 --- a/src/programs/ectrans-lam-benchmark.F90 +++ b/src/programs/ectrans-lam-benchmark.F90 @@ -1,3 +1,13 @@ +! (C) Copyright 2001- ECMWF. +! (C) Copyright 2001- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + program ectrans_lam_benchmark ! From e2978462f6b4265539a9e67a7bdc68061ebf049f Mon Sep 17 00:00:00 2001 From: Daan Degrauwe Date: Thu, 5 Dec 2024 10:08:01 +0000 Subject: [PATCH 16/25] removed fft992 sources --- src/etrans/cpu/internal/fft992.F90 | 2377 --------------------------- src/etrans/cpu/internal/set99.F90 | 82 - src/etrans/cpu/internal/set99b.F90 | 81 - src/etrans/cpu/internal/tpm_fft.F90 | 30 - 4 files changed, 2570 deletions(-) delete mode 100644 src/etrans/cpu/internal/fft992.F90 delete mode 100644 src/etrans/cpu/internal/set99.F90 delete mode 100644 src/etrans/cpu/internal/set99b.F90 delete mode 100644 src/etrans/cpu/internal/tpm_fft.F90 diff --git a/src/etrans/cpu/internal/fft992.F90 b/src/etrans/cpu/internal/fft992.F90 deleted file mode 100644 index 57aa6d373..000000000 --- a/src/etrans/cpu/internal/fft992.F90 +++ /dev/null @@ -1,2377 +0,0 @@ -! (C) Copyright 1998- ECMWF. -! (C) Copyright 2013- Meteo-France. -! -! This software is licensed under the terms of the Apache Licence Version 2.0 -! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. -! In applying this licence, ECMWF does not waive the privileges and immunities -! granted to it by virtue of its status as an intergovernmental organisation -! nor does it submit to any jurisdiction. -! - -! -! SUBROUTINE 'FFT992' - MULTIPLE FAST REAL PERIODIC TRANSFORM -! -! Author: Clive Temperton, January 1998 -! -! This routine is a modernized and enhanced version of FFT991 -! - Cray directives and ancient Fortran constructs removed -! - "vector chopping" removed -! - WORK array is now dynamically allocated -! - stride in WORK array is now always 1 -! -! REAL TRANSFORM OF LENGTH N PERFORMED BY REMOVING REDUNDANT -! OPERATIONS FROM COMPLEX TRANSFORM OF LENGTH N -! -! A IS THE ARRAY CONTAINING INPUT & OUTPUT DATA -! TRIGS IS A PREVIOUSLY PREPARED LIST OF TRIG FUNCTION VALUES -! IFAX IS A PREVIOUSLY PREPARED LIST OF FACTORS OF N -! INC IS THE INCREMENT WITHIN EACH DATA 'VECTOR' -! (E.G. INC=1 FOR CONSECUTIVELY STORED DATA) -! JUMP IS THE INCREMENT BETWEEN THE START OF EACH DATA VECTOR -! N IS THE LENGTH OF THE DATA VECTORS -! LOT IS THE NUMBER OF DATA VECTORS -! ISIGN = +1 FOR TRANSFORM FROM SPECTRAL TO GRIDPOINT -! = -1 FOR TRANSFORM FROM GRIDPOINT TO SPECTRAL -! -! ORDERING OF COEFFICIENTS: -! A(0),B(0),A(1),B(1),A(2),B(2),...,A(N/2),B(N/2) -! WHERE B(0)=B(N/2)=0; (N+2) LOCATIONS REQUIRED -! -! ORDERING OF DATA: -! X(0),X(1),X(2),...,X(N-1), 0 , 0 ; (N+2) LOCATIONS REQUIRED -! -! VECTORIZATION IS ACHIEVED BY DOING THE TRANSFORMS IN PARALLEL -! -! N MUST BE COMPOSED OF FACTORS 2,3 & 5 BUT DOES NOT HAVE TO BE EVEN -! -! DEFINITION OF TRANSFORMS: -! ------------------------- -! -! ISIGN=+1: X(J)=SUM(K=0,...,N-1)(C(K)*EXP(2*I*J*K*PI/N)) -! WHERE C(K)=A(K)+I*B(K) AND C(N-K)=A(K)-I*B(K) -! -! ISIGN=-1: A(K)=(1/N)*SUM(J=0,...,N-1)(X(J)*COS(2*J*K*PI/N)) -! B(K)=-(1/N)*SUM(J=0,...,N-1)(X(J)*SIN(2*J*K*PI/N)) -! -#ifdef MATHKEISAN -! MathKeisan is a scientific library optimized for NEC (www.mathkeisan.com) - - SUBROUTINE FFT992(A,TRIGS_,IFAX_,INC,JUMP,N,LOT,ISIGN) -!AUTOPROMOTE - USE PARKIND1, ONLY : JPIM, JPRB - USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK - IMPLICIT NONE - INTEGER(KIND=JPIM) :: N - REAL(KIND=JPRB) :: A(*) - REAL(KIND=JPRB) :: TRIGS_(N) - INTEGER(KIND=JPIM) :: IFAX_(10) - - INTEGER(KIND=JPIM) :: INC - INTEGER(KIND=JPIM) :: JUMP - INTEGER(KIND=JPIM) :: LOT - INTEGER(KIND=JPIM) :: ISIGN - - REAL(KIND=JPRB),ALLOCATABLE,DIMENSION(:),SAVE :: WORK , TRIGS - INTEGER(KIND=JPIM),SAVE :: IFAX (32) - - - INTEGER(KIND=JPIM), SAVE :: N_OLD=-1 - INTEGER(KIND=JPIM), SAVE :: LOT_OLD=-1 - -!$OMP threadprivate(ifax,n_old,lot_old,trigs,work) - - - REAL(KIND=JPHOOK) :: ZHOOK_HANDLE - IF (LHOOK) CALL DR_HOOK('FFT992',0,ZHOOK_HANDLE) - IF (N .NE. N_OLD) THEN - - IF( ALLOCATED( WORK ) ) DEALLOCATE( WORK ) - IF( ALLOCATED( TRIGS ) ) DEALLOCATE( TRIGS ) - - ALLOCATE(WORK(3*N*LOT)) - ALLOCATE(TRIGS(2*N)) - - CALL DFTFAX ( N, IFAX, TRIGS ) - - N_OLD = N - LOT_OLD = LOT - - ELSE - - IF (LOT .GT. LOT_OLD) THEN - - IF( ALLOCATED( WORK ) ) DEALLOCATE( WORK ) - ALLOCATE(WORK(3*N*LOT)) - LOT_OLD = LOT - - ENDIF - - ENDIF - - CALL DFFTMLT ( A, WORK, TRIGS, IFAX, INC, JUMP, N, LOT, ISIGN ) - - IF (LHOOK) CALL DR_HOOK('FFT992',1,ZHOOK_HANDLE) - RETURN - - END SUBROUTINE FFT992 -#else -! -! SUBROUTINE 'FFT992' - MULTIPLE FAST REAL PERIODIC TRANSFORM -! -! Author: Clive Temperton, January 1998 -! -! This routine is a modernized and enhanced version of FFT991 -! - Cray directives and ancient Fortran constructs removed -! - "vector chopping" removed -! - WORK array is now dynamically allocated -! - stride in WORK array is now always 1 -! -! REAL TRANSFORM OF LENGTH N PERFORMED BY REMOVING REDUNDANT -! OPERATIONS FROM COMPLEX TRANSFORM OF LENGTH N -! -! A IS THE ARRAY CONTAINING INPUT & OUTPUT DATA -! TRIGS IS A PREVIOUSLY PREPARED LIST OF TRIG FUNCTION VALUES -! IFAX IS A PREVIOUSLY PREPARED LIST OF FACTORS OF N -! INC IS THE INCREMENT WITHIN EACH DATA 'VECTOR' -! (E.G. INC=1 FOR CONSECUTIVELY STORED DATA) -! JUMP IS THE INCREMENT BETWEEN THE START OF EACH DATA VECTOR -! N IS THE LENGTH OF THE DATA VECTORS -! LOT IS THE NUMBER OF DATA VECTORS -! ISIGN = +1 FOR TRANSFORM FROM SPECTRAL TO GRIDPOINT -! = -1 FOR TRANSFORM FROM GRIDPOINT TO SPECTRAL -! -! ORDERING OF COEFFICIENTS: -! A(0),B(0),A(1),B(1),A(2),B(2),...,A(N/2),B(N/2) -! WHERE B(0)=B(N/2)=0; (N+2) LOCATIONS REQUIRED -! -! ORDERING OF DATA: -! X(0),X(1),X(2),...,X(N-1), 0 , 0 ; (N+2) LOCATIONS REQUIRED -! -! VECTORIZATION IS ACHIEVED BY DOING THE TRANSFORMS IN PARALLEL -! -! N MUST BE COMPOSED OF FACTORS 2,3 & 5 BUT DOES NOT HAVE TO BE EVEN -! -! DEFINITION OF TRANSFORMS: -! ------------------------- -! -! ISIGN=+1: X(J)=SUM(K=0,...,N-1)(C(K)*EXP(2*I*J*K*PI/N)) -! WHERE C(K)=A(K)+I*B(K) AND C(N-K)=A(K)-I*B(K) -! -! ISIGN=-1: A(K)=(1/N)*SUM(J=0,...,N-1)(X(J)*COS(2*J*K*PI/N)) -! B(K)=-(1/N)*SUM(J=0,...,N-1)(X(J)*SIN(2*J*K*PI/N)) -! - SUBROUTINE FFT992(A,TRIGS,IFAX,INC,JUMP,N,LOT,ISIGN) -!disabled for now. REK.!DEC$ OPTIMIZE:3 -!AUTOPROMOTE - USE PARKIND1, ONLY : JPIM, JPRB - USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK - IMPLICIT NONE -! - INTEGER(KIND=JPIM) :: N - INTEGER(KIND=JPIM) :: INC - INTEGER(KIND=JPIM) :: JBASE - INTEGER(KIND=JPIM) :: JUMP - INTEGER(KIND=JPIM) :: J,JJ,JUMPA - INTEGER(KIND=JPIM) :: LOT - INTEGER(KIND=JPIM) :: K,LA,NFAX - INTEGER(KIND=JPIM) :: ISIGN - INTEGER(KIND=JPIM) :: I,IA,IBASE,IERR,IFAC,IGO,II,INCA,IX - - REAL(KIND=JPRB) :: A(*) - REAL(KIND=JPRB) :: TRIGS(N) - INTEGER(KIND=JPIM) :: IFAX(10) -! Dynamically allocated work array: - REAL(KIND=JPRB) :: WORK(N*LOT+1) - LOGICAL :: LIPL -! - REAL(KIND=JPHOOK) :: ZHOOK_HANDLE - IF (LHOOK) CALL DR_HOOK('FFT992',0,ZHOOK_HANDLE) - NFAX=IFAX(1) - IF (ISIGN.EQ.+1) THEN -! -! ISIGN=+1, SPECTRAL TO GRIDPOINT TRANSFORM -! ----------------------------------------- -! - I=1 -!OCL NOVREC -!DEC$ IVDEP - DO J=1,LOT - A(I+INC)=0.5_JPRB*A(I) - I=I+JUMP - ENDDO - IF (MOD(N,2).EQ.0) THEN - I=N*INC+1 -!OCL NOVREC -!DEC$ IVDEP - DO J=1,LOT - A(I)=0.5_JPRB*A(I) - I=I+JUMP - ENDDO - ENDIF -! - IA=INC+1 - LA=1 - IGO=+1 -! - DO K=1,NFAX - IFAC=IFAX(K+1) - IERR=-1 - IF (K.EQ.NFAX.AND.NFAX.GT.2.AND.IGO.EQ.+1) THEN - LIPL=.TRUE. - ELSE - LIPL=.FALSE. - ENDIF - IF (INC.EQ.1.AND.JUMP.LT.(2*N).AND. & - & K.GT.1.AND.K.LT.(NFAX-MOD(NFAX,2))) THEN - INCA=LOT - JUMPA=1 - ELSE - INCA=INC - JUMPA=JUMP - ENDIF - IF (IGO.EQ.+1) THEN -!DEC$ FORCEINLINE - CALL RPASSF(A(IA),A(IA+LA*INCA),WORK(1),WORK(IFAC*LA*LOT+1), & - & TRIGS,INCA,LOT,JUMPA,1,LOT,N,IFAC,LA,IERR,LIPL) - ELSE -!DEC$ FORCEINLINE - CALL RPASSF(WORK(1),WORK(LA*LOT+1),A(IA),A(IA+IFAC*LA*INCA), & - & TRIGS,LOT,INCA,1,JUMPA,LOT,N,IFAC,LA,IERR,LIPL) - ENDIF - IF (IERR.NE.0) THEN - IF (IERR.EQ.2) WRITE(6,901) IFAC - IF (IERR.EQ.3) WRITE(6,902) IFAC - IF (LHOOK) CALL DR_HOOK('FFT992',1,ZHOOK_HANDLE) - RETURN - ENDIF - LA=IFAC*LA - IGO=-IGO - IA=1 - ENDDO -! -! IF NECESSARY, COPY RESULTS BACK TO A -! ------------------------------------ - IF (NFAX.EQ.1) THEN - IBASE=1 - JBASE=1 - DO JJ=1,N - I=IBASE - J=JBASE - DO II=1,LOT - A(J)=WORK(I) - I=I+1 - J=J+JUMP - ENDDO - IBASE=IBASE+LOT - JBASE=JBASE+INC - ENDDO - ENDIF -! -! FILL IN ZEROS AT END -! -------------------- - IX=N*INC+1 -!OCL NOVREC -!DEC$ IVDEP - DO J=1,LOT - A(IX)=0.0_JPRB - A(IX+INC)=0.0_JPRB - IX=IX+JUMP - ENDDO -! - ELSEIF (ISIGN.EQ.-1) THEN -! -! ISIGN=-1, GRIDPOINT TO SPECTRAL TRANSFORM -! ----------------------------------------- - IA=1 - LA=N - IGO=+1 -! - DO K=1,NFAX - IFAC=IFAX(NFAX+2-K) - LA=LA/IFAC - IERR=-1 - IF (K.EQ.1.AND.NFAX.GT.2.AND.MOD(NFAX,2).EQ.1) THEN - LIPL=.TRUE. - ELSE - LIPL=.FALSE. - ENDIF - IF (INC.EQ.1.AND.JUMP.LT.(2*N).AND. & - & K.GT.(1+MOD(NFAX,2)).AND.K.LT.NFAX) THEN - INCA=LOT - JUMPA=1 - ELSE - INCA=INC - JUMPA=JUMP - ENDIF - IF (IGO.EQ.+1) THEN -!DEC$ FORCEINLINE - CALL QPASSF(A(IA),A(IA+IFAC*LA*INCA),WORK(1),WORK(LA*LOT+1), & - & TRIGS,INCA,LOT,JUMPA,1,LOT,N,IFAC,LA,IERR,LIPL) - ELSE -!DEC$ FORCEINLINE - CALL QPASSF(WORK(1),WORK(IFAC*LA*LOT+1),A(IA),A(IA+LA*INCA), & - & TRIGS,LOT,INCA,1,JUMPA,LOT,N,IFAC,LA,IERR,LIPL) - ENDIF - IF (IERR.NE.0) THEN - IF (IERR.EQ.2) WRITE(6,901) IFAC - IF (IERR.EQ.3) WRITE(6,902) IFAC - IF (LHOOK) CALL DR_HOOK('FFT992',1,ZHOOK_HANDLE) - RETURN - ENDIF - IF (LIPL) THEN - IA=1 - ELSE - IGO=-IGO - IA=INC+1 - ENDIF - ENDDO -! -! IF NECESSARY, COPY RESULTS BACK TO A -! ------------------------------------ - IF (NFAX.EQ.1) THEN - IBASE=1 - JBASE=INC+1 - DO JJ=1,N - I=IBASE - J=JBASE - DO II=1,LOT - A(J)=WORK(I) - I=I+1 - J=J+JUMP - ENDDO - IBASE=IBASE+LOT - JBASE=JBASE+INC - ENDDO - ENDIF -! -! SHIFT A(0) & FILL IN ZERO IMAG PARTS -! ------------------------------------ - IX=1 -!OCL NOVREC -!DEC$ IVDEP - DO J=1,LOT - A(IX)=A(IX+INC) - A(IX+INC)=0.0_JPRB - IX=IX+JUMP - ENDDO - IF (MOD(N,2).EQ.0) THEN - IX=(N+1)*INC+1 - DO J=1,LOT - A(IX)=0.0_JPRB - IX=IX+JUMP - ENDDO - ENDIF -! - ENDIF -! -! FORMAT STATEMENTS FOR ERROR MESSAGES: - 901 FORMAT(' FACTOR =',I3,' NOT CATERED FOR') - 902 FORMAT(' FACTOR =',I3,' ONLY CATERED FOR IF LA*IFAC=N') -! - IF (LHOOK) CALL DR_HOOK('FFT992',1,ZHOOK_HANDLE) - - CONTAINS -! SUBROUTINE 'RPASSF' - PERFORMS ONE PASS THROUGH DATA AS PART -! OF MULTIPLE REAL FFT (FOURIER SYNTHESIS) ROUTINE -! -! A IS FIRST REAL INPUT VECTOR -! EQUIVALENCE B(1) WITH A (LA*INC1+1) -! C IS FIRST REAL OUTPUT VECTOR -! EQUIVALENCE D(1) WITH C(IFAC*LA*INC2+1) -! TRIGS IS A PRECALCULATED LIST OF SINES & COSINES -! INC1 IS THE ADDRESSING INCREMENT FOR A -! INC2 IS THE ADDRESSING INCREMENT FOR C -! INC3 IS THE INCREMENT BETWEEN INPUT VECTORS A -! INC4 IS THE INCREMENT BETWEEN OUTPUT VECTORS C -! LOT IS THE NUMBER OF VECTORS -! N IS THE LENGTH OF THE VECTORS -! IFAC IS THE CURRENT FACTOR OF N -! LA IS THE PRODUCT OF PREVIOUS FACTORS -! IERR IS AN ERROR INDICATOR: -! 0 - PASS COMPLETED WITHOUT ERROR -! 1 - LOT GREATER THAN 64 -! 2 - IFAC NOT CATERED FOR -! 3 - IFAC ONLY CATERED FOR IF LA=N/IFAC -! LIPL=.T. => RESULTS ARE RETURNED TO INPUT ARRAY -! (ONLY VALID IF LA=N/IFAC, I.E. ON LAST PASS) -! -!----------------------------------------------------------------------- -! - SUBROUTINE RPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & - & LA,IERR,LIPL) -!AUTOPROMOTE -! - USE PARKIND1, ONLY : JPIM, JPRB - USE YOMHOOK , ONLY : DR_HOOK, JPHOOK -! - IMPLICIT NONE -! - INTEGER(KIND=JPIM) :: N - REAL(KIND=JPRB) :: A(*) - REAL(KIND=JPRB) :: B(*) - REAL(KIND=JPRB) :: C(*) - REAL(KIND=JPRB) :: D(*) - REAL(KIND=JPRB) :: TRIGS(N) - REAL(KIND=JPRB) :: A10,A11,A20,A21 - REAL(KIND=JPRB) :: B10,B11,B20,B21 - REAL(KIND=JPRB) :: C1,C2,C3,C4,C5 - REAL(KIND=JPRB) :: S1,S2,S3,S4,S5 - REAL(KIND=JPRB) :: SIN36,SIN45,SIN60,SIN72 - REAL(KIND=JPRB) :: SSIN36,SSIN45,SSIN60,SSIN72 - REAL(KIND=JPRB) :: QRT5,QQRT5 - REAL(KIND=JPRB) :: T1,T2,T3,T4,T5,T6,T7 - INTEGER(KIND=JPIM) :: IERR - INTEGER(KIND=JPIM) :: INC1 - INTEGER(KIND=JPIM) :: INC2 - INTEGER(KIND=JPIM) :: INC3 - INTEGER(KIND=JPIM) :: INC4 - INTEGER(KIND=JPIM) :: LOT - INTEGER(KIND=JPIM) :: IFAC - INTEGER(KIND=JPIM) :: LA - INTEGER(KIND=JPIM) :: INC21,IINK,IJK,ILOT,ILA - INTEGER(KIND=JPIM) :: I,IA,IB,IBAD,IBASE,IC,ID,IE,IF - INTEGER(KIND=JPIM) :: J,JA,JB,JBASE,JC,JD,JE,JF,JG,JH,JINK,JUMP - INTEGER(KIND=JPIM) :: K,KB,KC,KD,KE,KF,KSTOP - INTEGER(KIND=JPIM) :: L,M - LOGICAL :: LIPL -! - DATA SIN36/0.587785252292473_JPRB/,SIN72/0.951056516295154_JPRB/, & - & QRT5/0.559016994374947_JPRB/,SIN60/0.866025403784437_JPRB/ -! - M=N/IFAC - IINK=LA*INC1 - JINK=LA*INC2 - JUMP=(IFAC-1)*JINK - KSTOP=(N-IFAC)/(2*IFAC) -! - IBASE=0 - JBASE=0 - IBAD=0 -! -! Increase the vector length by fusing the loops if the -! data layout is appropriate: - IF (INC1.EQ.LOT.AND.INC2.EQ.LOT.AND.INC3.EQ.1.AND.INC4.EQ.1) THEN - ILA=1 - ILOT=LA*LOT - INC21=LA*LOT - ELSE - ILA=LA - ILOT=LOT - INC21=INC2 - ENDIF -! - IF (IFAC.EQ.2) THEN -! -! CODING FOR FACTOR 2 -! ------------------- - 200 CONTINUE - IA=1 - IB=IA+(2*M-LA)*INC1 - JA=1 - JB=JA+JINK -! - IF (LA.NE.M) THEN -! - DO 220 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 210 IJK=1,ILOT - C(JA+J)=A(IA+I)+A(IB+I) - C(JB+J)=A(IA+I)-A(IB+I) - I=I+INC3 - J=J+INC4 - 210 CONTINUE - IBASE=IBASE+INC1 - JBASE=JBASE+INC21 - 220 CONTINUE - IA=IA+IINK - IINK=2*IINK - IB=IB-IINK - IBASE=0 - JBASE=JBASE+JUMP - JUMP=2*JUMP+JINK -! - IF (IA.LT.IB) THEN - DO 250 K=LA,KSTOP,LA - KB=K+K - C1=TRIGS(KB+1) - S1=TRIGS(KB+2) - IBASE=0 - DO 240 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 230 IJK=1,ILOT - C(JA+J)=A(IA+I)+A(IB+I) - D(JA+J)=B(IA+I)-B(IB+I) - C(JB+J)=C1*(A(IA+I)-A(IB+I))-S1*(B(IA+I)+B(IB+I)) - D(JB+J)=S1*(A(IA+I)-A(IB+I))+C1*(B(IA+I)+B(IB+I)) - I=I+INC3 - J=J+INC4 - 230 CONTINUE - IBASE=IBASE+INC1 - JBASE=JBASE+INC21 - 240 CONTINUE - IA=IA+IINK - IB=IB-IINK - JBASE=JBASE+JUMP - 250 CONTINUE - ENDIF -! - IF (IA.EQ.IB) THEN - IBASE=0 - DO 280 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 270 IJK=1,ILOT - C(JA+J)=A(IA+I) - C(JB+J)=-B(IA+I) - I=I+INC3 - J=J+INC4 - 270 CONTINUE - IBASE=IBASE+INC1 - JBASE=JBASE+INC21 - 280 CONTINUE - ENDIF -! - ELSE !!! Case LA=M - IF (LIPL) THEN - DO 294 L=1,ILA - I=IBASE -!OCL NOVREC -!NEC$ ivdep - DO 292 IJK=1,ILOT - T1=2.0*(A(IA+I)-A(IB+I)) - A(IA+I)=2.0_JPRB*(A(IA+I)+A(IB+I)) - A(IB+I)=T1 - I=I+INC3 - 292 CONTINUE - IBASE=IBASE+INC1 - 294 CONTINUE - ELSE - DO 298 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 296 IJK=1,ILOT - C(JA+J)=2.0_JPRB*(A(IA+I)+A(IB+I)) - C(JB+J)=2.0_JPRB*(A(IA+I)-A(IB+I)) - I=I+INC3 - J=J+INC4 - 296 CONTINUE - IBASE=IBASE+INC1 - JBASE=JBASE+INC21 - 298 CONTINUE - ENDIF - ENDIF -! - ELSEIF (IFAC.EQ.3) THEN -! -! CODING FOR FACTOR 3 -! ------------------- - 300 CONTINUE - IA=1 - IB=IA+(2*M-LA)*INC1 - IC=IB - JA=1 - JB=JA+JINK - JC=JB+JINK -! - IF (LA.NE.M) THEN -! - DO 320 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 310 IJK=1,ILOT - C(JA+J)=A(IA+I)+A(IB+I) - C(JB+J)=(A(IA+I)-0.5_JPRB*A(IB+I))-(SIN60*(B(IB+I))) - C(JC+J)=(A(IA+I)-0.5_JPRB*A(IB+I))+(SIN60*(B(IB+I))) - I=I+INC3 - J=J+INC4 - 310 CONTINUE - IBASE=IBASE+INC1 - JBASE=JBASE+INC21 - 320 CONTINUE - IA=IA+IINK - IINK=2*IINK - IB=IB+IINK - IC=IC-IINK - JBASE=JBASE+JUMP - JUMP=2*JUMP+JINK -! - IF (IA.LT.IC) THEN - DO 350 K=LA,KSTOP,LA - KB=K+K - KC=KB+KB - C1=TRIGS(KB+1) - S1=TRIGS(KB+2) - C2=TRIGS(KC+1) - S2=TRIGS(KC+2) - IBASE=0 - DO 340 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 330 IJK=1,ILOT - C(JA+J)=A(IA+I)+(A(IB+I)+A(IC+I)) - D(JA+J)=B(IA+I)+(B(IB+I)-B(IC+I)) - C(JB+J)= & - & C1*((A(IA+I)-0.5_JPRB*(A(IB+I)+A(IC+I)))- & - & (SIN60*(B(IB+I)+B(IC+I)))) & - & -S1*((B(IA+I)-0.5_JPRB*(B(IB+I)-B(IC+I)))+ & - & (SIN60*(A(IB+I)-A(IC+I)))) - D(JB+J)= & - & S1*((A(IA+I)-0.5_JPRB*(A(IB+I)+A(IC+I)))- & - & (SIN60*(B(IB+I)+B(IC+I)))) & - & +C1*((B(IA+I)-0.5_JPRB*(B(IB+I)-B(IC+I)))+ & - & (SIN60*(A(IB+I)-A(IC+I)))) - C(JC+J)= & - & C2*((A(IA+I)-0.5_JPRB*(A(IB+I)+A(IC+I)))+ & - & (SIN60*(B(IB+I)+B(IC+I)))) & - & -S2*((B(IA+I)-0.5_JPRB*(B(IB+I)-B(IC+I)))- & - & (SIN60*(A(IB+I)-A(IC+I)))) - D(JC+J)= & - & S2*((A(IA+I)-0.5_JPRB*(A(IB+I)+A(IC+I)))+ & - & (SIN60*(B(IB+I)+B(IC+I)))) & - & +C2*((B(IA+I)-0.5_JPRB*(B(IB+I)-B(IC+I)))- & - & (SIN60*(A(IB+I)-A(IC+I)))) - I=I+INC3 - J=J+INC4 - 330 CONTINUE - IBASE=IBASE+INC1 - JBASE=JBASE+INC21 - 340 CONTINUE - IA=IA+IINK - IB=IB+IINK - IC=IC-IINK - JBASE=JBASE+JUMP - 350 CONTINUE - ENDIF -! - IF (IA.EQ.IC) THEN - IBASE=0 - DO 380 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 370 IJK=1,ILOT - C(JA+J)=A(IA+I)+A(IB+I) - C(JB+J)=(0.5_JPRB*A(IA+I)-A(IB+I))-(SIN60*B(IA+I)) - C(JC+J)=-(0.5_JPRB*A(IA+I)-A(IB+I))-(SIN60*B(IA+I)) - I=I+INC3 - J=J+INC4 - 370 CONTINUE - IBASE=IBASE+INC1 - JBASE=JBASE+INC21 - 380 CONTINUE - ENDIF -! - ELSE !!! Case LA=M - SSIN60=2.0*SIN60 - IF (LIPL) THEN - DO 394 L=1,ILA - I=IBASE -!OCL NOVREC -!NEC$ ivdep - DO 392 IJK=1,ILOT - T1=(2.0_JPRB*A(IA+I)-A(IB+I))-(SSIN60*B(IB+I)) - T2=(2.0_JPRB*A(IA+I)-A(IB+I))+(SSIN60*B(IB+I)) - A(IA+I)=2.0_JPRB*(A(IA+I)+A(IB+I)) - A(IB+I)=T1 - B(IB+I)=T2 - I=I+INC3 - 392 CONTINUE - IBASE=IBASE+INC1 - 394 CONTINUE - ELSE - DO 398 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 396 IJK=1,ILOT - C(JA+J)=2.0_JPRB*(A(IA+I)+A(IB+I)) - C(JB+J)=(2.0_JPRB*A(IA+I)-A(IB+I))-(SSIN60*B(IB+I)) - C(JC+J)=(2.0_JPRB*A(IA+I)-A(IB+I))+(SSIN60*B(IB+I)) - I=I+INC3 - J=J+INC4 - 396 CONTINUE - IBASE=IBASE+INC1 - JBASE=JBASE+INC21 - 398 CONTINUE - ENDIF - ENDIF -! - ELSEIF (IFAC.EQ.4) THEN -! -! CODING FOR FACTOR 4 -! ------------------- - 400 CONTINUE - IA=1 - IB=IA+(2*M-LA)*INC1 - IC=IB+2*M*INC1 - ID=IB - JA=1 - JB=JA+JINK - JC=JB+JINK - JD=JC+JINK -! - IF (LA.NE.M) THEN -! - DO 420 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 410 IJK=1,ILOT - C(JA+J)=(A(IA+I)+A(IC+I))+A(IB+I) - C(JB+J)=(A(IA+I)-A(IC+I))-B(IB+I) - C(JC+J)=(A(IA+I)+A(IC+I))-A(IB+I) - C(JD+J)=(A(IA+I)-A(IC+I))+B(IB+I) - I=I+INC3 - J=J+INC4 - 410 CONTINUE - IBASE=IBASE+INC1 - JBASE=JBASE+INC21 - 420 CONTINUE - IA=IA+IINK - IINK=2*IINK - IB=IB+IINK - IC=IC-IINK - ID=ID-IINK - JBASE=JBASE+JUMP - JUMP=2*JUMP+JINK -! - IF (IB.LT.IC) THEN - DO 450 K=LA,KSTOP,LA - KB=K+K - KC=KB+KB - KD=KC+KB - C1=TRIGS(KB+1) - S1=TRIGS(KB+2) - C2=TRIGS(KC+1) - S2=TRIGS(KC+2) - C3=TRIGS(KD+1) - S3=TRIGS(KD+2) - IBASE=0 - DO 440 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 430 IJK=1,ILOT - C(JA+J)=(A(IA+I)+A(IC+I))+(A(IB+I)+A(ID+I)) - D(JA+J)=(B(IA+I)-B(IC+I))+(B(IB+I)-B(ID+I)) - C(JC+J)= & - & C2*((A(IA+I)+A(IC+I))-(A(IB+I)+A(ID+I))) & - & -S2*((B(IA+I)-B(IC+I))-(B(IB+I)-B(ID+I))) - D(JC+J)= & - & S2*((A(IA+I)+A(IC+I))-(A(IB+I)+A(ID+I))) & - & +C2*((B(IA+I)-B(IC+I))-(B(IB+I)-B(ID+I))) - C(JB+J)= & - & C1*((A(IA+I)-A(IC+I))-(B(IB+I)+B(ID+I))) & - & -S1*((B(IA+I)+B(IC+I))+(A(IB+I)-A(ID+I))) - D(JB+J)= & - & S1*((A(IA+I)-A(IC+I))-(B(IB+I)+B(ID+I))) & - & +C1*((B(IA+I)+B(IC+I))+(A(IB+I)-A(ID+I))) - C(JD+J)= & - & C3*((A(IA+I)-A(IC+I))+(B(IB+I)+B(ID+I))) & - & -S3*((B(IA+I)+B(IC+I))-(A(IB+I)-A(ID+I))) - D(JD+J)= & - & S3*((A(IA+I)-A(IC+I))+(B(IB+I)+B(ID+I))) & - & +C3*((B(IA+I)+B(IC+I))-(A(IB+I)-A(ID+I))) - I=I+INC3 - J=J+INC4 - 430 CONTINUE - IBASE=IBASE+INC1 - JBASE=JBASE+INC21 - 440 CONTINUE - IA=IA+IINK - IB=IB+IINK - IC=IC-IINK - ID=ID-IINK - JBASE=JBASE+JUMP - 450 CONTINUE - ENDIF -! - IF (IB.EQ.IC) THEN - IBASE=0 - SIN45=SQRT(0.5_JPRB) - DO 480 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 470 IJK=1,ILOT - C(JA+J)=A(IA+I)+A(IB+I) - C(JB+J)=SIN45*((A(IA+I)-A(IB+I))-(B(IA+I)+B(IB+I))) - C(JC+J)=B(IB+I)-B(IA+I) - C(JD+J)=-SIN45*((A(IA+I)-A(IB+I))+(B(IA+I)+B(IB+I))) - I=I+INC3 - J=J+INC4 - 470 CONTINUE - IBASE=IBASE+INC1 - JBASE=JBASE+INC21 - 480 CONTINUE - ENDIF -! - ELSE !!! Case LA=M - IF (LIPL) THEN - DO 494 L=1,ILA - I=IBASE -!OCL NOVREC -!NEC$ ivdep - DO 492 IJK=1,ILOT - T1=2.0_JPRB*((A(IA+I)-A(IC+I))-B(IB+I)) - T2=2.0_JPRB*((A(IA+I)+A(IC+I))-A(IB+I)) - T3=2.0_JPRB*((A(IA+I)-A(IC+I))+B(IB+I)) - A(IA+I)=2.0_JPRB*((A(IA+I)+A(IC+I))+A(IB+I)) - A(IB+I)=T1 - B(IB+I)=T2 - A(IC+I)=T3 - I=I+INC3 - 492 CONTINUE - IBASE=IBASE+INC1 - 494 CONTINUE - ELSE - DO 498 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 496 IJK=1,ILOT - C(JA+J)=2.0_JPRB*((A(IA+I)+A(IC+I))+A(IB+I)) - C(JB+J)=2.0_JPRB*((A(IA+I)-A(IC+I))-B(IB+I)) - C(JC+J)=2.0_JPRB*((A(IA+I)+A(IC+I))-A(IB+I)) - C(JD+J)=2.0_JPRB*((A(IA+I)-A(IC+I))+B(IB+I)) - I=I+INC3 - J=J+INC4 - 496 CONTINUE - IBASE=IBASE+INC1 - JBASE=JBASE+INC21 - 498 CONTINUE - ENDIF - ENDIF -! - ELSEIF (IFAC.EQ.5) THEN -! -! CODING FOR FACTOR 5 -! ------------------- - 500 CONTINUE - IA=1 - IB=IA+(2*M-LA)*INC1 - IC=IB+2*M*INC1 - ID=IC - IE=IB - JA=1 - JB=JA+JINK - JC=JB+JINK - JD=JC+JINK - JE=JD+JINK -! - IF (LA.NE.M) THEN -! - DO 520 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 510 IJK=1,ILOT - C(JA+J)=A(IA+I)+(A(IB+I)+A(IC+I)) - C(JB+J)=((A(IA+I)-0.25_JPRB*(A(IB+I)+A(IC+I)))+ & - & QRT5*(A(IB+I)-A(IC+I)))-(SIN72*B(IB+I)+SIN36*B(IC+I)) - C(JC+J)=((A(IA+I)-0.25_JPRB*(A(IB+I)+A(IC+I)))- & - & QRT5*(A(IB+I)-A(IC+I)))-(SIN36*B(IB+I)-SIN72*B(IC+I)) - C(JD+J)=((A(IA+I)-0.25_JPRB*(A(IB+I)+A(IC+I)))- & - & QRT5*(A(IB+I)-A(IC+I)))+(SIN36*B(IB+I)-SIN72*B(IC+I)) - C(JE+J)=((A(IA+I)-0.25_JPRB*(A(IB+I)+A(IC+I)))+ & - & QRT5*(A(IB+I)-A(IC+I)))+(SIN72*B(IB+I)+SIN36*B(IC+I)) - I=I+INC3 - J=J+INC4 - 510 CONTINUE - IBASE=IBASE+INC1 - JBASE=JBASE+INC21 - 520 CONTINUE - IA=IA+IINK - IINK=2*IINK - IB=IB+IINK - IC=IC+IINK - ID=ID-IINK - IE=IE-IINK - JBASE=JBASE+JUMP - JUMP=2*JUMP+JINK -! - IF (IB.LT.ID) THEN - DO 550 K=LA,KSTOP,LA - KB=K+K - KC=KB+KB - KD=KC+KB - KE=KD+KB - C1=TRIGS(KB+1) - S1=TRIGS(KB+2) - C2=TRIGS(KC+1) - S2=TRIGS(KC+2) - C3=TRIGS(KD+1) - S3=TRIGS(KD+2) - C4=TRIGS(KE+1) - S4=TRIGS(KE+2) - IBASE=0 - DO 540 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 530 IJK=1,ILOT -! - A10=(A(IA+I)-0.25_JPRB*((A(IB+I)+A(IE+I))+(A(IC+I)+A(ID+I)))) & - & +QRT5*((A(IB+I)+A(IE+I))-(A(IC+I)+A(ID+I))) - A20=(A(IA+I)-0.25_JPRB*((A(IB+I)+A(IE+I))+(A(IC+I)+A(ID+I)))) & - & -QRT5*((A(IB+I)+A(IE+I))-(A(IC+I)+A(ID+I))) - B10=(B(IA+I)-0.25_JPRB*((B(IB+I)-B(IE+I))+(B(IC+I)-B(ID+I)))) & - & +QRT5*((B(IB+I)-B(IE+I))-(B(IC+I)-B(ID+I))) - B20=(B(IA+I)-0.25_JPRB*((B(IB+I)-B(IE+I))+(B(IC+I)-B(ID+I)))) & - & -QRT5*((B(IB+I)-B(IE+I))-(B(IC+I)-B(ID+I))) - A11=SIN72*(B(IB+I)+B(IE+I))+SIN36*(B(IC+I)+B(ID+I)) - A21=SIN36*(B(IB+I)+B(IE+I))-SIN72*(B(IC+I)+B(ID+I)) - B11=SIN72*(A(IB+I)-A(IE+I))+SIN36*(A(IC+I)-A(ID+I)) - B21=SIN36*(A(IB+I)-A(IE+I))-SIN72*(A(IC+I)-A(ID+I)) -! - C(JA+J)=A(IA+I)+((A(IB+I)+A(IE+I))+(A(IC+I)+A(ID+I))) - D(JA+J)=B(IA+I)+((B(IB+I)-B(IE+I))+(B(IC+I)-B(ID+I))) - C(JB+J)=C1*(A10-A11)-S1*(B10+B11) - D(JB+J)=S1*(A10-A11)+C1*(B10+B11) - C(JE+J)=C4*(A10+A11)-S4*(B10-B11) - D(JE+J)=S4*(A10+A11)+C4*(B10-B11) - C(JC+J)=C2*(A20-A21)-S2*(B20+B21) - D(JC+J)=S2*(A20-A21)+C2*(B20+B21) - C(JD+J)=C3*(A20+A21)-S3*(B20-B21) - D(JD+J)=S3*(A20+A21)+C3*(B20-B21) -! - I=I+INC3 - J=J+INC4 - 530 CONTINUE - IBASE=IBASE+INC1 - JBASE=JBASE+INC21 - 540 CONTINUE - IA=IA+IINK - IB=IB+IINK - IC=IC+IINK - ID=ID-IINK - IE=IE-IINK - JBASE=JBASE+JUMP - 550 CONTINUE - ENDIF -! - IF (IB.EQ.ID) THEN - IBASE=0 - DO 580 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 570 IJK=1,ILOT - C(JA+J)=(A(IA+I)+A(IB+I))+A(IC+I) - C(JB+J)=(QRT5*(A(IA+I)-A(IB+I))+ & - & (0.25_JPRB*(A(IA+I)+A(IB+I))-A(IC+I))) & - & -(SIN36*B(IA+I)+SIN72*B(IB+I)) - C(JE+J)=-(QRT5*(A(IA+I)-A(IB+I))+ & - & (0.25_JPRB*(A(IA+I)+A(IB+I))-A(IC+I))) & - & -(SIN36*B(IA+I)+SIN72*B(IB+I)) - C(JC+J)=(QRT5*(A(IA+I)-A(IB+I))- & - & (0.25_JPRB*(A(IA+I)+A(IB+I))-A(IC+I))) & - & -(SIN72*B(IA+I)-SIN36*B(IB+I)) - C(JD+J)=-(QRT5*(A(IA+I)-A(IB+I))- & - & (0.25_JPRB*(A(IA+I)+A(IB+I))-A(IC+I))) & - & -(SIN72*B(IA+I)-SIN36*B(IB+I)) - I=I+INC3 - J=J+INC4 - 570 CONTINUE - IBASE=IBASE+INC1 - JBASE=JBASE+INC21 - 580 CONTINUE - ENDIF -! - ELSE !!! Case LA=M - QQRT5=2.0*QRT5 - SSIN36=2.0*SIN36 - SSIN72=2.0*SIN72 - IF (LIPL) THEN - DO 594 L=1,ILA - I=IBASE -!OCL NOVREC -!NEC$ ivdep - DO 592 IJK=1,ILOT - T1=(2.0_JPRB*(A(IA+I)-0.25_JPRB*(A(IB+I)+A(IC+I))) & - & +QQRT5*(A(IB+I)-A(IC+I)))-(SSIN72*B(IB+I)+SSIN36*B(IC+I)) - T2=(2.0_JPRB*(A(IA+I)-0.25_JPRB*(A(IB+I)+A(IC+I))) & - & -QQRT5*(A(IB+I)-A(IC+I)))-(SSIN36*B(IB+I)-SSIN72*B(IC+I)) - T3=(2.0_JPRB*(A(IA+I)-0.25_JPRB*(A(IB+I)+A(IC+I))) & - & -QQRT5*(A(IB+I)-A(IC+I)))+(SSIN36*B(IB+I)-SSIN72*B(IC+I)) - T4=(2.0_JPRB*(A(IA+I)-0.25_JPRB*(A(IB+I)+A(IC+I))) & - & +QQRT5*(A(IB+I)-A(IC+I)))+(SSIN72*B(IB+I)+SSIN36*B(IC+I)) - A(IA+I)=2.0_JPRB*(A(IA+I)+(A(IB+I)+A(IC+I))) - A(IB+I)=T1 - B(IB+I)=T2 - A(IC+I)=T3 - B(IC+I)=T4 - I=I+INC3 - 592 CONTINUE - IBASE=IBASE+INC1 - 594 CONTINUE - ELSE - DO 598 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 596 IJK=1,ILOT - C(JA+J)=2.0_JPRB*(A(IA+I)+(A(IB+I)+A(IC+I))) - C(JB+J)=(2.0_JPRB*(A(IA+I)-0.25_JPRB*(A(IB+I)+A(IC+I))) & - & +QQRT5*(A(IB+I)-A(IC+I)))-(SSIN72*B(IB+I)+SSIN36*B(IC+I)) - C(JC+J)=(2.0_JPRB*(A(IA+I)-0.25_JPRB*(A(IB+I)+A(IC+I))) & - & -QQRT5*(A(IB+I)-A(IC+I)))-(SSIN36*B(IB+I)-SSIN72*B(IC+I)) - C(JD+J)=(2.0_JPRB*(A(IA+I)-0.25_JPRB*(A(IB+I)+A(IC+I))) & - & -QQRT5*(A(IB+I)-A(IC+I)))+(SSIN36*B(IB+I)-SSIN72*B(IC+I)) - C(JE+J)=(2.0_JPRB*(A(IA+I)-0.25_JPRB*(A(IB+I)+A(IC+I))) & - & +QQRT5*(A(IB+I)-A(IC+I)))+(SSIN72*B(IB+I)+SSIN36*B(IC+I)) - I=I+INC3 - J=J+INC4 - 596 CONTINUE - IBASE=IBASE+INC1 - JBASE=JBASE+INC21 - 598 CONTINUE - ENDIF - ENDIF -! - ELSEIF (IFAC.EQ.6) THEN -! -! CODING FOR FACTOR 6 -! ------------------- - 600 CONTINUE - IA=1 - IB=IA+(2*M-LA)*INC1 - IC=IB+2*M*INC1 - ID=IC+2*M*INC1 - IE=IC - IF=IB - JA=1 - JB=JA+JINK - JC=JB+JINK - JD=JC+JINK - JE=JD+JINK - JF=JE+JINK -! - IF (LA.NE.M) THEN -! - DO 620 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 610 IJK=1,ILOT - C(JA+J)=(A(IA+I)+A(ID+I))+(A(IB+I)+A(IC+I)) - C(JD+J)=(A(IA+I)-A(ID+I))-(A(IB+I)-A(IC+I)) - C(JB+J)=((A(IA+I)-A(ID+I))+0.5_JPRB*(A(IB+I)-A(IC+I))) & - & -(SIN60*(B(IB+I)+B(IC+I))) - C(JF+J)=((A(IA+I)-A(ID+I))+0.5_JPRB*(A(IB+I)-A(IC+I))) & - & +(SIN60*(B(IB+I)+B(IC+I))) - C(JC+J)=((A(IA+I)+A(ID+I))-0.5_JPRB*(A(IB+I)+A(IC+I))) & - & -(SIN60*(B(IB+I)-B(IC+I))) - C(JE+J)=((A(IA+I)+A(ID+I))-0.5_JPRB*(A(IB+I)+A(IC+I))) & - & +(SIN60*(B(IB+I)-B(IC+I))) - I=I+INC3 - J=J+INC4 - 610 CONTINUE - IBASE=IBASE+INC1 - JBASE=JBASE+INC21 - 620 CONTINUE - IA=IA+IINK - IINK=2*IINK - IB=IB+IINK - IC=IC+IINK - ID=ID-IINK - IE=IE-IINK - IF=IF-IINK - JBASE=JBASE+JUMP - JUMP=2*JUMP+JINK -! - IF (IC.LT.ID) THEN - DO 650 K=LA,KSTOP,LA - KB=K+K - KC=KB+KB - KD=KC+KB - KE=KD+KB - KF=KE+KB - C1=TRIGS(KB+1) - S1=TRIGS(KB+2) - C2=TRIGS(KC+1) - S2=TRIGS(KC+2) - C3=TRIGS(KD+1) - S3=TRIGS(KD+2) - C4=TRIGS(KE+1) - S4=TRIGS(KE+2) - C5=TRIGS(KF+1) - S5=TRIGS(KF+2) - IBASE=0 - DO 640 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 630 IJK=1,ILOT -! - A11= (A(IE+I)+A(IB+I))+(A(IC+I)+A(IF+I)) - A20=(A(IA+I)+A(ID+I))-0.5_JPRB*A11 - A21=SIN60*((A(IE+I)+A(IB+I))-(A(IC+I)+A(IF+I))) - B11= (B(IB+I)-B(IE+I))+(B(IC+I)-B(IF+I)) - B20=(B(IA+I)-B(ID+I))-0.5_JPRB*B11 - B21=SIN60*((B(IB+I)-B(IE+I))-(B(IC+I)-B(IF+I))) -! - C(JA+J)=(A(IA+I)+A(ID+I))+A11 - D(JA+J)=(B(IA+I)-B(ID+I))+B11 - C(JC+J)=C2*(A20-B21)-S2*(B20+A21) - D(JC+J)=S2*(A20-B21)+C2*(B20+A21) - C(JE+J)=C4*(A20+B21)-S4*(B20-A21) - D(JE+J)=S4*(A20+B21)+C4*(B20-A21) -! - A11=(A(IE+I)-A(IB+I))+(A(IC+I)-A(IF+I)) - B11=(B(IE+I)+B(IB+I))-(B(IC+I)+B(IF+I)) - A20=(A(IA+I)-A(ID+I))-0.5_JPRB*A11 - A21=SIN60*((A(IE+I)-A(IB+I))-(A(IC+I)-A(IF+I))) - B20=(B(IA+I)+B(ID+I))+0.5_JPRB*B11 - B21=SIN60*((B(IE+I)+B(IB+I))+(B(IC+I)+B(IF+I))) -! - C(JD+J)= & - & C3*((A(IA+I)-A(ID+I))+A11)-S3*((B(IA+I)+B(ID+I))-B11) - D(JD+J)= & - & S3*((A(IA+I)-A(ID+I))+A11)+C3*((B(IA+I)+B(ID+I))-B11) - C(JB+J)=C1*(A20-B21)-S1*(B20-A21) - D(JB+J)=S1*(A20-B21)+C1*(B20-A21) - C(JF+J)=C5*(A20+B21)-S5*(B20+A21) - D(JF+J)=S5*(A20+B21)+C5*(B20+A21) -! - I=I+INC3 - J=J+INC4 - 630 CONTINUE - IBASE=IBASE+INC1 - JBASE=JBASE+INC21 - 640 CONTINUE - IA=IA+IINK - IB=IB+IINK - IC=IC+IINK - ID=ID-IINK - IE=IE-IINK - IF=IF-IINK - JBASE=JBASE+JUMP - 650 CONTINUE - ENDIF -! - IF (IC.EQ.ID) THEN - IBASE=0 - DO 680 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 670 IJK=1,ILOT - C(JA+J)=A(IB+I)+(A(IA+I)+A(IC+I)) - C(JD+J)=B(IB+I)-(B(IA+I)+B(IC+I)) - C(JB+J)=(SIN60*(A(IA+I)-A(IC+I)))- & - & (0.5_JPRB*(B(IA+I)+B(IC+I))+B(IB+I)) - C(JF+J)=-(SIN60*(A(IA+I)-A(IC+I)))- & - & (0.5_JPRB*(B(IA+I)+B(IC+I))+B(IB+I)) - C(JC+J)=SIN60*(B(IC+I)-B(IA+I))+ & - & (0.5_JPRB*(A(IA+I)+A(IC+I))-A(IB+I)) - C(JE+J)=SIN60*(B(IC+I)-B(IA+I))- & - & (0.5_JPRB*(A(IA+I)+A(IC+I))-A(IB+I)) - I=I+INC3 - J=J+INC4 - 670 CONTINUE - IBASE=IBASE+INC1 - JBASE=JBASE+INC21 - 680 CONTINUE - ENDIF -! - ELSE !!! Case LA=M - SSIN60=2.0_JPRB*SIN60 - IF (LIPL) THEN - DO 694 L=1,ILA - I=IBASE -!OCL NOVREC -!NEC$ ivdep - DO 692 IJK=1,ILOT - T1=(2.0_JPRB*(A(IA+I)-A(ID+I))+(A(IB+I)-A(IC+I))) & - & -(SSIN60*(B(IB+I)+B(IC+I))) - T5=(2.0_JPRB*(A(IA+I)-A(ID+I))+(A(IB+I)-A(IC+I))) & - & +(SSIN60*(B(IB+I)+B(IC+I))) - T2=(2.0_JPRB*(A(IA+I)+A(ID+I))-(A(IB+I)+A(IC+I))) & - & -(SSIN60*(B(IB+I)-B(IC+I))) - T4=(2.0_JPRB*(A(IA+I)+A(ID+I))-(A(IB+I)+A(IC+I))) & - & +(SSIN60*(B(IB+I)-B(IC+I))) - T3=(2.0_JPRB*(A(IA+I)-A(ID+I)))-(2.0_JPRB*(A(IB+I)-A(IC+I))) - A(IA+I)=(2.0_JPRB*(A(IA+I)+A(ID+I)))+ & - & (2.0_JPRB*(A(IB+I)+A(IC+I))) - A(IB+I)=T1 - B(IB+I)=T2 - A(IC+I)=T3 - B(IC+I)=T4 - A(ID+I)=T5 - I=I+INC3 - 692 CONTINUE - IBASE=IBASE+INC1 - 694 CONTINUE - ELSE - DO 698 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 696 IJK=1,ILOT - C(JA+J)=(2.0_JPRB*(A(IA+I)+A(ID+I)))+ & - & (2.0_JPRB*(A(IB+I)+A(IC+I))) - C(JD+J)=(2.0_JPRB*(A(IA+I)-A(ID+I)))- & - & (2.0_JPRB*(A(IB+I)-A(IC+I))) - C(JB+J)=(2.0_JPRB*(A(IA+I)-A(ID+I))+(A(IB+I)-A(IC+I))) & - & -(SSIN60*(B(IB+I)+B(IC+I))) - C(JF+J)=(2.0_JPRB*(A(IA+I)-A(ID+I))+(A(IB+I)-A(IC+I))) & - & +(SSIN60*(B(IB+I)+B(IC+I))) - C(JC+J)=(2.0_JPRB*(A(IA+I)+A(ID+I))-(A(IB+I)+A(IC+I))) & - & -(SSIN60*(B(IB+I)-B(IC+I))) - C(JE+J)=(2.0_JPRB*(A(IA+I)+A(ID+I))-(A(IB+I)+A(IC+I))) & - & +(SSIN60*(B(IB+I)-B(IC+I))) - I=I+INC3 - J=J+INC4 - 696 CONTINUE - IBASE=IBASE+INC1 - JBASE=JBASE+INC21 - 698 CONTINUE - ENDIF - ENDIF -! - ELSEIF (IFAC.EQ.8) THEN -! -! CODING FOR FACTOR 8 -! ------------------- - 800 CONTINUE - IF (LA.NE.M) THEN - IBAD=3 - ELSE - IA=1 - IB=IA+LA*INC1 - IC=IB+2*LA*INC1 - ID=IC+2*LA*INC1 - IE=ID+2*LA*INC1 - JA=1 - JB=JA+JINK - JC=JB+JINK - JD=JC+JINK - JE=JD+JINK - JF=JE+JINK - JG=JF+JINK - JH=JG+JINK - SSIN45=SQRT(2.0_JPRB) -! - IF (LIPL) THEN - DO 820 L=1,ILA - I=IBASE -!OCL NOVREC -!NEC$ ivdep - DO 810 IJK=1,ILOT - T2=2.0_JPRB*(((A(IA+I)+A(IE+I))-A(IC+I))-(B(IB+I)-B(ID+I))) - T6=2.0_JPRB*(((A(IA+I)+A(IE+I))-A(IC+I))+(B(IB+I)-B(ID+I))) - T1=2.0_JPRB*((A(IA+I)-A(IE+I))-B(IC+I)) & - & +SSIN45*((A(IB+I)-A(ID+I))-(B(IB+I)+B(ID+I))) - T5=2.0_JPRB*((A(IA+I)-A(IE+I))-B(IC+I)) & - & -SSIN45*((A(IB+I)-A(ID+I))-(B(IB+I)+B(ID+I))) - T3=2.0_JPRB*((A(IA+I)-A(IE+I))+B(IC+I)) & - & -SSIN45*((A(IB+I)-A(ID+I))+(B(IB+I)+B(ID+I))) - T7=2.0_JPRB*((A(IA+I)-A(IE+I))+B(IC+I)) & - & +SSIN45*((A(IB+I)-A(ID+I))+(B(IB+I)+B(ID+I))) - T4=2.0_JPRB*(((A(IA+I)+A(IE+I))+A(IC+I))-(A(IB+I)+A(ID+I))) - A(IA+I)=2.0_JPRB*(((A(IA+I)+A(IE+I))+A(IC+I))+(A(IB+I)+A(ID+I))) - A(IB+I)=T1 - B(IB+I)=T2 - A(IC+I)=T3 - B(IC+I)=T4 - A(ID+I)=T5 - B(ID+I)=T6 - A(IE+I)=T7 - I=I+INC3 - 810 CONTINUE - IBASE=IBASE+INC1 - 820 CONTINUE - ELSE - DO 840 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 830 IJK=1,ILOT - C(JA+J)=2.0_JPRB*(((A(IA+I)+A(IE+I))+A(IC+I))+(A(IB+I)+A(ID+I))) - C(JE+J)=2.0_JPRB*(((A(IA+I)+A(IE+I))+A(IC+I))-(A(IB+I)+A(ID+I))) - C(JC+J)=2.0_JPRB*(((A(IA+I)+A(IE+I))-A(IC+I))-(B(IB+I)-B(ID+I))) - C(JG+J)=2.0_JPRB*(((A(IA+I)+A(IE+I))-A(IC+I))+(B(IB+I)-B(ID+I))) - C(JB+J)=2.0_JPRB*((A(IA+I)-A(IE+I))-B(IC+I)) & - & +SSIN45*((A(IB+I)-A(ID+I))-(B(IB+I)+B(ID+I))) - C(JF+J)=2.0_JPRB*((A(IA+I)-A(IE+I))-B(IC+I)) & - & -SSIN45*((A(IB+I)-A(ID+I))-(B(IB+I)+B(ID+I))) - C(JD+J)=2.0_JPRB*((A(IA+I)-A(IE+I))+B(IC+I)) & - & -SSIN45*((A(IB+I)-A(ID+I))+(B(IB+I)+B(ID+I))) - C(JH+J)=2.0_JPRB*((A(IA+I)-A(IE+I))+B(IC+I)) & - & +SSIN45*((A(IB+I)-A(ID+I))+(B(IB+I)+B(ID+I))) - I=I+INC3 - J=J+INC4 - 830 CONTINUE - IBASE=IBASE+INC1 - JBASE=JBASE+INC21 - 840 CONTINUE - ENDIF -! - ENDIF -! - ELSE -! - IBAD=2 !!! Illegal factor -! - ENDIF -! -! RETURN -! ------ - 900 CONTINUE - IERR=IBAD - ENDSUBROUTINE RPASSF - -! SUBROUTINE 'QPASSF' - PERFORMS ONE PASS THROUGH DATA AS PART -! OF MULTIPLE REAL FFT (FOURIER ANALYSIS) ROUTINE -! -! A IS FIRST REAL INPUT VECTOR -! EQUIVALENCE B(1) WITH A(IFAC*LA*INC1+1) -! C IS FIRST REAL OUTPUT VECTOR -! EQUIVALENCE D(1) WITH C(LA*INC2+1) -! TRIGS IS A PRECALCULATED LIST OF SINES & COSINES -! INC1 IS THE ADDRESSING INCREMENT FOR A -! INC2 IS THE ADDRESSING INCREMENT FOR C -! INC3 IS THE INCREMENT BETWEEN INPUT VECTORS A -! INC4 IS THE INCREMENT BETWEEN OUTPUT VECTORS C -! LOT IS THE NUMBER OF VECTORS -! N IS THE LENGTH OF THE VECTORS -! IFAC IS THE CURRENT FACTOR OF N -! LA = N/(PRODUCT OF FACTORS USED SO FAR) -! IERR IS AN ERROR INDICATOR: -! 0 - PASS COMPLETED WITHOUT ERROR -! 1 - LOT GREATER THAN 64 -! 2 - IFAC NOT CATERED FOR -! 3 - IFAC ONLY CATERED FOR IF LA=N/IFAC -! LIPL=.T. => RESULTS ARE RETURNED TO INPUT ARRAY -! (ONLY VALID IF LA=N/IFAC, I.E. ON FIRST PASS) -! -!----------------------------------------------------------------------- -! - SUBROUTINE QPASSF(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,LOT,N,IFAC, & - & LA,IERR,LIPL) -!AUTOPROMOTE - USE PARKIND1, ONLY : JPIM, JPRB - USE YOMHOOK , ONLY : DR_HOOK, JPHOOK -! - IMPLICIT NONE -! - INTEGER(KIND=JPIM) :: N - REAL(KIND=JPRB) :: A(*) - REAL(KIND=JPRB) :: B(*) - REAL(KIND=JPRB) :: C(*) - REAL(KIND=JPRB) :: D(*) - REAL(KIND=JPRB) :: TRIGS(N) - REAL(KIND=JPRB) :: A0,A1,A2,A3,A4,A5,A6,A10,A11,A20,A21 - REAL(KIND=JPRB) :: B0,B1,B2,B3,B4,B5,B6,B10,B11,B20,B21 - REAL(KIND=JPRB) :: C1,C2,C3,C4,C5 - REAL(KIND=JPRB) :: S1,S2,S3,S4,S5 - REAL(KIND=JPRB) :: T1,T2,T3,T4,T5,T6,T7 - REAL(KIND=JPRB) :: Z - REAL(KIND=JPRB) :: QRT5,SIN36,SIN45,SIN60,SIN72 - REAL(KIND=JPRB) :: ZQRT5,ZSIN36,ZSIN45,ZSIN60,ZSIN72 - INTEGER(KIND=JPIM) :: IERR - INTEGER(KIND=JPIM) :: INC1 - INTEGER(KIND=JPIM) :: INC2 - INTEGER(KIND=JPIM) :: INC3 - INTEGER(KIND=JPIM) :: INC4 - INTEGER(KIND=JPIM) :: LOT - INTEGER(KIND=JPIM) :: IFAC - INTEGER(KIND=JPIM) :: LA - INTEGER(KIND=JPIM) :: IINK,IJK,ILOT - INTEGER(KIND=JPIM) :: I,IA,IB,IBAD,IBASE,IC,ID,IE,IF,IG,IH - INTEGER(KIND=JPIM) :: IJUMP,ILA,INC11 - INTEGER(KIND=JPIM) :: J,JA,JB,JC,JD,JE,JBASE,JF,JINK - INTEGER(KIND=JPIM) :: K,KB,KC,KD,KE,KF,KSTOP - INTEGER(KIND=JPIM) :: L,M - LOGICAL :: LIPL -! - DATA SIN36/0.587785252292473_JPRB/,SIN72/0.951056516295154_JPRB/, & - & QRT5/0.559016994374947_JPRB/,SIN60/0.866025403784437_JPRB/ -! - M=N/IFAC - IINK=LA*INC1 - JINK=LA*INC2 - IJUMP=(IFAC-1)*IINK - KSTOP=(N-IFAC)/(2*IFAC) -! - IBASE=0 - JBASE=0 - IBAD=0 -! -! Increase the vector length by fusing the loops if the -! data layout is appropriate: - IF (INC1.EQ.LOT.AND.INC2.EQ.LOT.AND.INC3.EQ.1.AND.INC4.EQ.1) THEN - ILA=1 - ILOT=LA*LOT - INC11=LA*LOT - ELSE - ILA=LA - ILOT=LOT - INC11=INC1 - ENDIF - -! - IF (IFAC.EQ.2) THEN -! -! CODING FOR FACTOR 2 -! ------------------- - 200 CONTINUE - IA=1 - IB=IA+IINK - JA=1 - JB=JA+(2*M-LA)*INC2 -! - IF (LA.NE.M) THEN -! - DO 220 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 210 IJK=1,ILOT - C(JA+J)=A(IA+I)+A(IB+I) - C(JB+J)=A(IA+I)-A(IB+I) - I=I+INC3 - J=J+INC4 - 210 CONTINUE - IBASE=IBASE+INC11 - JBASE=JBASE+INC2 - 220 CONTINUE - JA=JA+JINK - JINK=2*JINK - JB=JB-JINK - IBASE=IBASE+IJUMP - IJUMP=2*IJUMP+IINK -! - IF (JA.LT.JB) THEN - DO 250 K=LA,KSTOP,LA - KB=K+K - C1=TRIGS(KB+1) - S1=TRIGS(KB+2) - JBASE=0 - DO 240 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 230 IJK=1,ILOT - C(JA+J)=A(IA+I)+(C1*A(IB+I)+S1*B(IB+I)) - C(JB+J)=A(IA+I)-(C1*A(IB+I)+S1*B(IB+I)) - D(JA+J)=(C1*B(IB+I)-S1*A(IB+I))+B(IA+I) - D(JB+J)=(C1*B(IB+I)-S1*A(IB+I))-B(IA+I) - I=I+INC3 - J=J+INC4 - 230 CONTINUE - IBASE=IBASE+INC11 - JBASE=JBASE+INC2 - 240 CONTINUE - IBASE=IBASE+IJUMP - JA=JA+JINK - JB=JB-JINK - 250 CONTINUE - ENDIF -! - IF (JA.EQ.JB) THEN - JBASE=0 - DO 280 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 270 IJK=1,ILOT - C(JA+J)=A(IA+I) - D(JA+J)=-A(IB+I) - I=I+INC3 - J=J+INC4 - 270 CONTINUE - IBASE=IBASE+INC11 - JBASE=JBASE+INC2 - 280 CONTINUE - ENDIF -! - ELSE !!! Case LA=M - Z=1.0_JPRB/REAL(N,KIND=JPRB) - IF (LIPL) THEN - DO 294 L=1,ILA - I=IBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 292 IJK=1,ILOT - T1=Z*(A(IA+I)-A(IB+I)) - A(IA+I)=Z*(A(IA+I)+A(IB+I)) - A(IB+I)=T1 - I=I+INC3 - 292 CONTINUE - IBASE=IBASE+INC11 - 294 CONTINUE - ELSE - DO 298 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 296 IJK=1,ILOT - C(JA+J)=Z*(A(IA+I)+A(IB+I)) - C(JB+J)=Z*(A(IA+I)-A(IB+I)) - I=I+INC3 - J=J+INC4 - 296 CONTINUE - IBASE=IBASE+INC11 - JBASE=JBASE+INC2 - 298 CONTINUE - ENDIF - ENDIF -! - ELSEIF (IFAC.EQ.3) THEN -! -! CODING FOR FACTOR 3 -! ------------------- - 300 CONTINUE - IA=1 - IB=IA+IINK - IC=IB+IINK - JA=1 - JB=JA+(2*M-LA)*INC2 - JC=JB -! - IF (LA.NE.M) THEN -! - DO 320 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 310 IJK=1,ILOT - C(JA+J)=A(IA+I)+(A(IB+I)+A(IC+I)) - C(JB+J)=A(IA+I)-0.5_JPRB*(A(IB+I)+A(IC+I)) - D(JB+J)=SIN60*(A(IC+I)-A(IB+I)) - I=I+INC3 - J=J+INC4 - 310 CONTINUE - IBASE=IBASE+INC11 - JBASE=JBASE+INC2 - 320 CONTINUE - JA=JA+JINK - JINK=2*JINK - JB=JB+JINK - JC=JC-JINK - IBASE=IBASE+IJUMP - IJUMP=2*IJUMP+IINK -! - IF (JA.LT.JC) THEN - DO 350 K=LA,KSTOP,LA - KB=K+K - KC=KB+KB - C1=TRIGS(KB+1) - S1=TRIGS(KB+2) - C2=TRIGS(KC+1) - S2=TRIGS(KC+2) - JBASE=0 - DO 340 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 330 IJK=1,ILOT - A1=(C1*A(IB+I)+S1*B(IB+I))+(C2*A(IC+I)+S2*B(IC+I)) - B1=(C1*B(IB+I)-S1*A(IB+I))+(C2*B(IC+I)-S2*A(IC+I)) - A2=A(IA+I)-0.5_JPRB*A1 - B2=B(IA+I)-0.5_JPRB*B1 - A3=SIN60*((C1*A(IB+I)+S1*B(IB+I))-(C2*A(IC+I)+S2*B(IC+I))) - B3=SIN60*((C1*B(IB+I)-S1*A(IB+I))-(C2*B(IC+I)-S2*A(IC+I))) - C(JA+J)=A(IA+I)+A1 - D(JA+J)=B(IA+I)+B1 - C(JB+J)=A2+B3 - D(JB+J)=B2-A3 - C(JC+J)=A2-B3 - D(JC+J)=-(B2+A3) - I=I+INC3 - J=J+INC4 - 330 CONTINUE - IBASE=IBASE+INC11 - JBASE=JBASE+INC2 - 340 CONTINUE - IBASE=IBASE+IJUMP - JA=JA+JINK - JB=JB+JINK - JC=JC-JINK - 350 CONTINUE - ENDIF -! - IF (JA.EQ.JC) THEN - JBASE=0 - DO 380 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 370 IJK=1,ILOT - C(JA+J)=A(IA+I)+0.5_JPRB*(A(IB+I)-A(IC+I)) - D(JA+J)=-SIN60*(A(IB+I)+A(IC+I)) - C(JB+J)=A(IA+I)-(A(IB+I)-A(IC+I)) - I=I+INC3 - J=J+INC4 - 370 CONTINUE - IBASE=IBASE+INC11 - JBASE=JBASE+INC2 - 380 CONTINUE - ENDIF -! - ELSE !!! Case LA=M - Z=1.0_JPRB/REAL(N,KIND=JPRB) - ZSIN60=Z*SIN60 - IF (LIPL) THEN - DO 394 L=1,ILA - I=IBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 392 IJK=1,ILOT - T1=Z*(A(IA+I)-0.5_JPRB*(A(IB+I)+A(IC+I))) - T2=ZSIN60*(A(IC+I)-A(IB+I)) - A(IA+I)=Z*(A(IA+I)+(A(IB+I)+A(IC+I))) - A(IB+I)=T1 - A(IC+I)=T2 - I=I+INC3 - 392 CONTINUE - IBASE=IBASE+INC11 - 394 CONTINUE - ELSE - DO 398 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 396 IJK=1,ILOT - C(JA+J)=Z*(A(IA+I)+(A(IB+I)+A(IC+I))) - C(JB+J)=Z*(A(IA+I)-0.5_JPRB*(A(IB+I)+A(IC+I))) - D(JB+J)=ZSIN60*(A(IC+I)-A(IB+I)) - I=I+INC3 - J=J+INC4 - 396 CONTINUE - IBASE=IBASE+INC11 - JBASE=JBASE+INC2 - 398 CONTINUE - ENDIF - ENDIF -! - ELSEIF (IFAC.EQ.4) THEN -! -! CODING FOR FACTOR 4 -! ------------------- - 400 CONTINUE - IA=1 - IB=IA+IINK - IC=IB+IINK - ID=IC+IINK - JA=1 - JB=JA+(2*M-LA)*INC2 - JC=JB+2*M*INC2 - JD=JB -! - IF (LA.NE.M) THEN -! - DO 420 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 410 IJK=1,ILOT - C(JA+J)=(A(IA+I)+A(IC+I))+(A(IB+I)+A(ID+I)) - C(JC+J)=(A(IA+I)+A(IC+I))-(A(IB+I)+A(ID+I)) - C(JB+J)=A(IA+I)-A(IC+I) - D(JB+J)=A(ID+I)-A(IB+I) - I=I+INC3 - J=J+INC4 - 410 CONTINUE - IBASE=IBASE+INC11 - JBASE=JBASE+INC2 - 420 CONTINUE - JA=JA+JINK - JINK=2*JINK - JB=JB+JINK - JC=JC-JINK - JD=JD-JINK - IBASE=IBASE+IJUMP - IJUMP=2*IJUMP+IINK -! - IF (JB.LT.JC) THEN - DO 450 K=LA,KSTOP,LA - KB=K+K - KC=KB+KB - KD=KC+KB - C1=TRIGS(KB+1) - S1=TRIGS(KB+2) - C2=TRIGS(KC+1) - S2=TRIGS(KC+2) - C3=TRIGS(KD+1) - S3=TRIGS(KD+2) - JBASE=0 - DO 440 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 430 IJK=1,ILOT - A0=A(IA+I)+(C2*A(IC+I)+S2*B(IC+I)) - A2=A(IA+I)-(C2*A(IC+I)+S2*B(IC+I)) - A1=(C1*A(IB+I)+S1*B(IB+I))+(C3*A(ID+I)+S3*B(ID+I)) - A3=(C1*A(IB+I)+S1*B(IB+I))-(C3*A(ID+I)+S3*B(ID+I)) - B0=B(IA+I)+(C2*B(IC+I)-S2*A(IC+I)) - B2=B(IA+I)-(C2*B(IC+I)-S2*A(IC+I)) - B1=(C1*B(IB+I)-S1*A(IB+I))+(C3*B(ID+I)-S3*A(ID+I)) - B3=(C1*B(IB+I)-S1*A(IB+I))-(C3*B(ID+I)-S3*A(ID+I)) - C(JA+J)=A0+A1 - C(JC+J)=A0-A1 - D(JA+J)=B0+B1 - D(JC+J)=B1-B0 - C(JB+J)=A2+B3 - C(JD+J)=A2-B3 - D(JB+J)=B2-A3 - D(JD+J)=-(B2+A3) - I=I+INC3 - J=J+INC4 - 430 CONTINUE - IBASE=IBASE+INC11 - JBASE=JBASE+INC2 - 440 CONTINUE - IBASE=IBASE+IJUMP - JA=JA+JINK - JB=JB+JINK - JC=JC-JINK - JD=JD-JINK - 450 CONTINUE - ENDIF -! - IF (JB.EQ.JC) THEN - SIN45=SQRT(0.5_JPRB) - JBASE=0 - DO 480 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 470 IJK=1,ILOT - C(JA+J)=A(IA+I)+SIN45*(A(IB+I)-A(ID+I)) - C(JB+J)=A(IA+I)-SIN45*(A(IB+I)-A(ID+I)) - D(JA+J)=-A(IC+I)-SIN45*(A(IB+I)+A(ID+I)) - D(JB+J)=A(IC+I)-SIN45*(A(IB+I)+A(ID+I)) - I=I+INC3 - J=J+INC4 - 470 CONTINUE - IBASE=IBASE+INC11 - JBASE=JBASE+INC2 - 480 CONTINUE - ENDIF -! - ELSE !!! Case LA=M - Z=1.0_JPRB/REAL(N,KIND=JPRB) - IF (LIPL) THEN - DO 494 L=1,ILA - I=IBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 492 IJK=1,ILOT - T1=Z*(A(IA+I)-A(IC+I)) - T3=Z*(A(ID+I)-A(IB+I)) - T2=Z*((A(IA+I)+A(IC+I))-(A(IB+I)+A(ID+I))) - A(IA+I)=Z*((A(IA+I)+A(IC+I))+(A(IB+I)+A(ID+I))) - A(IB+I)=T1 - A(IC+I)=T2 - A(ID+I)=T3 - I=I+INC3 - 492 CONTINUE - IBASE=IBASE+INC11 - 494 CONTINUE - ELSE - DO 498 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 496 IJK=1,ILOT - C(JA+J)=Z*((A(IA+I)+A(IC+I))+(A(IB+I)+A(ID+I))) - C(JC+J)=Z*((A(IA+I)+A(IC+I))-(A(IB+I)+A(ID+I))) - C(JB+J)=Z*(A(IA+I)-A(IC+I)) - D(JB+J)=Z*(A(ID+I)-A(IB+I)) - I=I+INC3 - J=J+INC4 - 496 CONTINUE - IBASE=IBASE+INC11 - JBASE=JBASE+INC2 - 498 CONTINUE - ENDIF - ENDIF -! - ELSEIF (IFAC.EQ.5) THEN -! -! CODING FOR FACTOR 5 -! ------------------- - 500 CONTINUE - IA=1 - IB=IA+IINK - IC=IB+IINK - ID=IC+IINK - IE=ID+IINK - JA=1 - JB=JA+(2*M-LA)*INC2 - JC=JB+2*M*INC2 - JD=JC - JE=JB -! - IF (LA.NE.M) THEN -! - DO 520 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 510 IJK=1,ILOT - A1=A(IB+I)+A(IE+I) - A3=A(IB+I)-A(IE+I) - A2=A(IC+I)+A(ID+I) - A4=A(IC+I)-A(ID+I) - A5=A(IA+I)-0.25_JPRB*(A1+A2) - A6=QRT5*(A1-A2) - C(JA+J)=A(IA+I)+(A1+A2) - C(JB+J)=A5+A6 - C(JC+J)=A5-A6 - D(JB+J)=-SIN72*A3-SIN36*A4 - D(JC+J)=-SIN36*A3+SIN72*A4 - I=I+INC3 - J=J+INC4 - 510 CONTINUE - IBASE=IBASE+INC11 - JBASE=JBASE+INC2 - 520 CONTINUE - JA=JA+JINK - JINK=2*JINK - JB=JB+JINK - JC=JC+JINK - JD=JD-JINK - JE=JE-JINK - IBASE=IBASE+IJUMP - IJUMP=2*IJUMP+IINK -! - IF (JB.LT.JD) THEN - DO 550 K=LA,KSTOP,LA - KB=K+K - KC=KB+KB - KD=KC+KB - KE=KD+KB - C1=TRIGS(KB+1) - S1=TRIGS(KB+2) - C2=TRIGS(KC+1) - S2=TRIGS(KC+2) - C3=TRIGS(KD+1) - S3=TRIGS(KD+2) - C4=TRIGS(KE+1) - S4=TRIGS(KE+2) - JBASE=0 - DO 540 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 530 IJK=1,ILOT - A1=(C1*A(IB+I)+S1*B(IB+I))+(C4*A(IE+I)+S4*B(IE+I)) - A3=(C1*A(IB+I)+S1*B(IB+I))-(C4*A(IE+I)+S4*B(IE+I)) - A2=(C2*A(IC+I)+S2*B(IC+I))+(C3*A(ID+I)+S3*B(ID+I)) - A4=(C2*A(IC+I)+S2*B(IC+I))-(C3*A(ID+I)+S3*B(ID+I)) - B1=(C1*B(IB+I)-S1*A(IB+I))+(C4*B(IE+I)-S4*A(IE+I)) - B3=(C1*B(IB+I)-S1*A(IB+I))-(C4*B(IE+I)-S4*A(IE+I)) - B2=(C2*B(IC+I)-S2*A(IC+I))+(C3*B(ID+I)-S3*A(ID+I)) - B4=(C2*B(IC+I)-S2*A(IC+I))-(C3*B(ID+I)-S3*A(ID+I)) - A5=A(IA+I)-0.25_JPRB*(A1+A2) - A6=QRT5*(A1-A2) - B5=B(IA+I)-0.25_JPRB*(B1+B2) - B6=QRT5*(B1-B2) - A10=A5+A6 - A20=A5-A6 - B10=B5+B6 - B20=B5-B6 - A11=SIN72*B3+SIN36*B4 - A21=SIN36*B3-SIN72*B4 - B11=SIN72*A3+SIN36*A4 - B21=SIN36*A3-SIN72*A4 - C(JA+J)=A(IA+I)+(A1+A2) - C(JB+J)=A10+A11 - C(JE+J)=A10-A11 - C(JC+J)=A20+A21 - C(JD+J)=A20-A21 - D(JA+J)=B(IA+I)+(B1+B2) - D(JB+J)=B10-B11 - D(JE+J)=-(B10+B11) - D(JC+J)=B20-B21 - D(JD+J)=-(B20+B21) - I=I+INC3 - J=J+INC4 - 530 CONTINUE - IBASE=IBASE+INC11 - JBASE=JBASE+INC2 - 540 CONTINUE - IBASE=IBASE+IJUMP - JA=JA+JINK - JB=JB+JINK - JC=JC+JINK - JD=JD-JINK - JE=JE-JINK - 550 CONTINUE - ENDIF -! - IF (JB.EQ.JD) THEN - JBASE=0 - DO 580 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 570 IJK=1,ILOT - A1=A(IB+I)+A(IE+I) - A3=A(IB+I)-A(IE+I) - A2=A(IC+I)+A(ID+I) - A4=A(IC+I)-A(ID+I) - A5=A(IA+I)+0.25_JPRB*(A3-A4) - A6=QRT5*(A3+A4) - C(JA+J)=A5+A6 - C(JB+J)=A5-A6 - C(JC+J)=A(IA+I)-(A3-A4) - D(JA+J)=-SIN36*A1-SIN72*A2 - D(JB+J)=-SIN72*A1+SIN36*A2 - I=I+INC3 - J=J+INC4 - 570 CONTINUE - IBASE=IBASE+INC11 - JBASE=JBASE+INC2 - 580 CONTINUE - ENDIF -! - ELSE !!! Case LA=M - Z=1.0_JPRB/REAL(N,KIND=JPRB) - ZQRT5=Z*QRT5 - ZSIN36=Z*SIN36 - ZSIN72=Z*SIN72 - IF (LIPL) THEN - DO 594 L=1,ILA - I=IBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 592 IJK=1,ILOT - A1=A(IB+I)+A(IE+I) - A3=A(IB+I)-A(IE+I) - A2=A(IC+I)+A(ID+I) - A4=A(IC+I)-A(ID+I) - A5=Z*(A(IA+I)-0.25_JPRB*(A1+A2)) - A6=ZQRT5*(A1-A2) - A(IA+I)=Z*(A(IA+I)+(A1+A2)) - A(IB+I)=A5+A6 - A(ID+I)=A5-A6 - A(IC+I)=-ZSIN72*A3-ZSIN36*A4 - A(IE+I)=-ZSIN36*A3+ZSIN72*A4 - I=I+INC3 - 592 CONTINUE - IBASE=IBASE+INC11 - 594 CONTINUE - ELSE - DO 598 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 596 IJK=1,ILOT - A1=A(IB+I)+A(IE+I) - A3=A(IB+I)-A(IE+I) - A2=A(IC+I)+A(ID+I) - A4=A(IC+I)-A(ID+I) - A5=Z*(A(IA+I)-0.25_JPRB*(A1+A2)) - A6=ZQRT5*(A1-A2) - C(JA+J)=Z*(A(IA+I)+(A1+A2)) - C(JB+J)=A5+A6 - C(JC+J)=A5-A6 - D(JB+J)=-ZSIN72*A3-ZSIN36*A4 - D(JC+J)=-ZSIN36*A3+ZSIN72*A4 - I=I+INC3 - J=J+INC4 - 596 CONTINUE - IBASE=IBASE+INC11 - JBASE=JBASE+INC2 - 598 CONTINUE - ENDIF - ENDIF -! - ELSEIF (IFAC.EQ.6) THEN -! -! CODING FOR FACTOR 6 -! ------------------- - 600 CONTINUE - IA=1 - IB=IA+IINK - IC=IB+IINK - ID=IC+IINK - IE=ID+IINK - IF=IE+IINK - JA=1 - JB=JA+(2*M-LA)*INC2 - JC=JB+2*M*INC2 - JD=JC+2*M*INC2 - JE=JC - JF=JB -! - IF (LA.NE.M) THEN -! - DO 620 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 610 IJK=1,ILOT - A11=(A(IC+I)+A(IF+I))+(A(IB+I)+A(IE+I)) - C(JA+J)=(A(IA+I)+A(ID+I))+A11 - C(JC+J)=(A(IA+I)+A(ID+I)-0.5_JPRB*A11) - D(JC+J)=SIN60*((A(IC+I)+A(IF+I))-(A(IB+I)+A(IE+I))) - A11=(A(IC+I)-A(IF+I))+(A(IE+I)-A(IB+I)) - C(JB+J)=(A(IA+I)-A(ID+I))-0.5_JPRB*A11 - D(JB+J)=SIN60*((A(IE+I)-A(IB+I))-(A(IC+I)-A(IF+I))) - C(JD+J)=(A(IA+I)-A(ID+I))+A11 - I=I+INC3 - J=J+INC4 - 610 CONTINUE - IBASE=IBASE+INC11 - JBASE=JBASE+INC2 - 620 CONTINUE - JA=JA+JINK - JINK=2*JINK - JB=JB+JINK - JC=JC+JINK - JD=JD-JINK - JE=JE-JINK - JF=JF-JINK - IBASE=IBASE+IJUMP - IJUMP=2*IJUMP+IINK -! - IF (JC.LT.JD) THEN - DO 650 K=LA,KSTOP,LA - KB=K+K - KC=KB+KB - KD=KC+KB - KE=KD+KB - KF=KE+KB - C1=TRIGS(KB+1) - S1=TRIGS(KB+2) - C2=TRIGS(KC+1) - S2=TRIGS(KC+2) - C3=TRIGS(KD+1) - S3=TRIGS(KD+2) - C4=TRIGS(KE+1) - S4=TRIGS(KE+2) - C5=TRIGS(KF+1) - S5=TRIGS(KF+2) - JBASE=0 - DO 640 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 630 IJK=1,ILOT - A1=C1*A(IB+I)+S1*B(IB+I) - B1=C1*B(IB+I)-S1*A(IB+I) - A2=C2*A(IC+I)+S2*B(IC+I) - B2=C2*B(IC+I)-S2*A(IC+I) - A3=C3*A(ID+I)+S3*B(ID+I) - B3=C3*B(ID+I)-S3*A(ID+I) - A4=C4*A(IE+I)+S4*B(IE+I) - B4=C4*B(IE+I)-S4*A(IE+I) - A5=C5*A(IF+I)+S5*B(IF+I) - B5=C5*B(IF+I)-S5*A(IF+I) - A11=(A2+A5)+(A1+A4) - A20=(A(IA+I)+A3)-0.5_JPRB*A11 - A21=SIN60*((A2+A5)-(A1+A4)) - B11=(B2+B5)+(B1+B4) - B20=(B(IA+I)+B3)-0.5_JPRB*B11 - B21=SIN60*((B2+B5)-(B1+B4)) - C(JA+J)=(A(IA+I)+A3)+A11 - D(JA+J)=(B(IA+I)+B3)+B11 - C(JC+J)=A20-B21 - D(JC+J)=A21+B20 - C(JE+J)=A20+B21 - D(JE+J)=A21-B20 - A11=(A2-A5)+(A4-A1) - A20=(A(IA+I)-A3)-0.5_JPRB*A11 - A21=SIN60*((A4-A1)-(A2-A5)) - B11=(B5-B2)-(B4-B1) - B20=(B3-B(IA+I))-0.5_JPRB*B11 - B21=SIN60*((B5-B2)+(B4-B1)) - C(JB+J)=A20-B21 - D(JB+J)=A21-B20 - C(JD+J)=A11+(A(IA+I)-A3) - D(JD+J)=B11+(B3-B(IA+I)) - C(JF+J)=A20+B21 - D(JF+J)=A21+B20 - I=I+INC3 - J=J+INC4 - 630 CONTINUE - IBASE=IBASE+INC11 - JBASE=JBASE+INC2 - 640 CONTINUE - IBASE=IBASE+IJUMP - JA=JA+JINK - JB=JB+JINK - JC=JC+JINK - JD=JD-JINK - JE=JE-JINK - JF=JF-JINK - 650 CONTINUE - ENDIF -! - IF (JC.EQ.JD) THEN - JBASE=0 - DO 680 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 670 IJK=1,ILOT - C(JA+J)=(A(IA+I)+0.5_JPRB*(A(IC+I)-A(IE+I)))+ & - & SIN60*(A(IB+I)-A(IF+I)) - D(JA+J)=-(A(ID+I)+0.5_JPRB*(A(IB+I)+A(IF+I)))- & - & SIN60*(A(IC+I)+A(IE+I)) - C(JB+J)=A(IA+I)-(A(IC+I)-A(IE+I)) - D(JB+J)=A(ID+I)-(A(IB+I)+A(IF+I)) - C(JC+J)=(A(IA+I)+0.5_JPRB*(A(IC+I)-A(IE+I)))- & - & SIN60*(A(IB+I)-A(IF+I)) - D(JC+J)=-(A(ID+I)+0.5_JPRB*(A(IB+I)+ & - & A(IF+I)))+SIN60*(A(IC+I)+A(IE+I)) - I=I+INC3 - J=J+INC4 - 670 CONTINUE - IBASE=IBASE+INC11 - JBASE=JBASE+INC2 - 680 CONTINUE - ENDIF -! - ELSE !!! Case LA=M - Z=1.0_JPRB/REAL(N,KIND=JPRB) - ZSIN60=Z*SIN60 - IF (LIPL) THEN - DO 694 L=1,ILA - I=IBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 692 IJK=1,ILOT - A11=(A(IC+I)-A(IF+I))+(A(IE+I)-A(IB+I)) - T1=Z*((A(IA+I)-A(ID+I))-0.5_JPRB*A11) - T5=Z*((A(IA+I)-A(ID+I))+A11) - T2=ZSIN60*((A(IE+I)-A(IB+I))-(A(IC+I)-A(IF+I))) - T4=ZSIN60*((A(IC+I)+A(IF+I))-(A(IB+I)+A(IE+I))) - A11=(A(IC+I)+A(IF+I))+(A(IB+I)+A(IE+I)) - T3=Z*((A(IA+I)+A(ID+I))-0.5_JPRB*A11) - A(IA+I)=Z*((A(IA+I)+A(ID+I))+A11) - A(IB+I)=T1 - A(IC+I)=T2 - A(ID+I)=T3 - A(IE+I)=T4 - A(IF+I)=T5 - I=I+INC3 - 692 CONTINUE - IBASE=IBASE+INC11 - 694 CONTINUE - ELSE - DO 698 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 696 IJK=1,ILOT - A11=(A(IC+I)+A(IF+I))+(A(IB+I)+A(IE+I)) - C(JA+J)=Z*((A(IA+I)+A(ID+I))+A11) - C(JC+J)=Z*((A(IA+I)+A(ID+I))-0.5_JPRB*A11) - D(JC+J)=ZSIN60*((A(IC+I)+A(IF+I))-(A(IB+I)+A(IE+I))) - A11=(A(IC+I)-A(IF+I))+(A(IE+I)-A(IB+I)) - C(JB+J)=Z*((A(IA+I)-A(ID+I))-0.5_JPRB*A11) - D(JB+J)=ZSIN60*((A(IE+I)-A(IB+I))-(A(IC+I)-A(IF+I))) - C(JD+J)=Z*((A(IA+I)-A(ID+I))+A11) - I=I+INC3 - J=J+INC4 - 696 CONTINUE - IBASE=IBASE+INC11 - JBASE=JBASE+INC2 - 698 CONTINUE - ENDIF - ENDIF -! - ELSEIF (IFAC.EQ.8) THEN -! -! CODING FOR FACTOR 8 -! ------------------- - 800 CONTINUE - IF (LA.NE.M) THEN - IBAD=3 - ELSE - IA=1 - IB=IA+IINK - IC=IB+IINK - ID=IC+IINK - IE=ID+IINK - IF=IE+IINK - IG=IF+IINK - IH=IG+IINK - JA=1 - JB=JA+LA*INC2 - JC=JB+2*M*INC2 - JD=JC+2*M*INC2 - JE=JD+2*M*INC2 - Z=1.0_JPRB/REAL(N,KIND=JPRB) - ZSIN45=Z*SQRT(0.5_JPRB) -! - IF (LIPL) THEN - DO 820 L=1,ILA - I=IBASE -!OCL NOVREC -!DEC$ IVDEP -!NEC$ ivdep - DO 810 IJK=1,ILOT - T3=Z*((A(IA+I)+A(IE+I))-(A(IC+I)+A(IG+I))) - T4=Z*((A(ID+I)+A(IH+I))-(A(IB+I)+A(IF+I))) - T1=Z*(A(IA+I)-A(IE+I)) & - & +ZSIN45*((A(IH+I)-A(ID+I))-(A(IF+I)-A(IB+I))) - T5=Z*(A(IA+I)-A(IE+I)) & - & -ZSIN45*((A(IH+I)-A(ID+I))-(A(IF+I)-A(IB+I))) - T2=ZSIN45*((A(IH+I)-A(ID+I))+(A(IF+I)-A(IB+I))) & - & +Z*(A(IG+I)-A(IC+I)) - T6=ZSIN45*((A(IH+I)-A(ID+I))+(A(IF+I)-A(IB+I))) & - & -Z*(A(IG+I)-A(IC+I)) - T7=Z*(((A(IA+I)+A(IE+I))+(A(IC+I)+A(IG+I)))- & - & ((A(ID+I)+A(IH+I))+(A(IB+I)+A(IF+I)))) - A(IA+I)=Z*(((A(IA+I)+A(IE+I))+(A(IC+I)+A(IG+I)))+ & - & ((A(ID+I)+A(IH+I))+(A(IB+I)+A(IF+I)))) - A(IB+I)=T1 - A(IC+I)=T2 - A(ID+I)=T3 - A(IE+I)=T4 - A(IF+I)=T5 - A(IG+I)=T6 - A(IH+I)=T7 - I=I+INC3 - 810 CONTINUE - IBASE=IBASE+INC11 - 820 CONTINUE - ELSE - DO 840 L=1,ILA - I=IBASE - J=JBASE -!OCL NOVREC -!DEC$ IVDEP - DO 830 IJK=1,ILOT - C(JA+J)=Z*(((A(IA+I)+A(IE+I))+(A(IC+I)+A(IG+I)))+ & - & ((A(ID+I)+A(IH+I))+(A(IB+I)+A(IF+I)))) - C(JE+J)=Z*(((A(IA+I)+A(IE+I))+(A(IC+I)+A(IG+I)))- & - & ((A(ID+I)+A(IH+I))+(A(IB+I)+A(IF+I)))) - C(JC+J)=Z*((A(IA+I)+A(IE+I))-(A(IC+I)+A(IG+I))) - D(JC+J)=Z*((A(ID+I)+A(IH+I))-(A(IB+I)+A(IF+I))) - C(JB+J)=Z*(A(IA+I)-A(IE+I)) & - & +ZSIN45*((A(IH+I)-A(ID+I))-(A(IF+I)-A(IB+I))) - C(JD+J)=Z*(A(IA+I)-A(IE+I)) & - & -ZSIN45*((A(IH+I)-A(ID+I))-(A(IF+I)-A(IB+I))) - D(JB+J)=ZSIN45*((A(IH+I)-A(ID+I))+(A(IF+I)-A(IB+I))) & - & +Z*(A(IG+I)-A(IC+I)) - D(JD+J)=ZSIN45*((A(IH+I)-A(ID+I))+(A(IF+I)-A(IB+I))) & - & -Z*(A(IG+I)-A(IC+I)) - I=I+INC3 - J=J+INC4 - 830 CONTINUE - IBASE=IBASE+INC11 - JBASE=JBASE+INC2 - 840 CONTINUE - ENDIF -! - ENDIF -! - ELSE -! - IBAD=2 !!! Illegal factor -! - ENDIF -! -! RETURN -! ------ - 900 CONTINUE - IERR=IBAD - ENDSUBROUTINE QPASSF - - ENDSUBROUTINE FFT992 -#endif \ No newline at end of file diff --git a/src/etrans/cpu/internal/set99.F90 b/src/etrans/cpu/internal/set99.F90 deleted file mode 100644 index 0ea5f8c4d..000000000 --- a/src/etrans/cpu/internal/set99.F90 +++ /dev/null @@ -1,82 +0,0 @@ -! (C) Copyright 1998- ECMWF. -! (C) Copyright 2013- Meteo-France. -! -! This software is licensed under the terms of the Apache Licence Version 2.0 -! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. -! In applying this licence, ECMWF does not waive the privileges and immunities -! granted to it by virtue of its status as an intergovernmental organisation -! nor does it submit to any jurisdiction. -! - - SUBROUTINE SET99(TRIGS,IFAX,N) -!AUTOPROMOTE - USE PARKIND1, ONLY : JPIM, JPRB - USE YOMHOOK , ONLY : LHOOK, DR_HOOK, JPHOOK -! - IMPLICIT NONE -! - INTEGER(KIND=JPIM) :: N - INTEGER(KIND=JPIM) :: I,IFAC,IL,IXXX,K,NHL,NIL,NFAX,NU - REAL(KIND=JPRB) :: ANGLE,DEL - REAL(KIND=JPRB) :: TRIGS(N) - INTEGER(KIND=JPIM) :: IFAX(*) - INTEGER(KIND=JPIM) :: JFAX(10),NLFAX(7) -! -! SUBROUTINE 'SET99' - COMPUTES FACTORS OF N & TRIGONOMETRIC -! FUNCTIONS REQUIRED BY FFT99 & FFT991 -! - SAVE NLFAX -! - DATA NLFAX/6,8,5,4,3,2,1/ -! - REAL(KIND=JPHOOK) :: ZHOOK_HANDLE - IF (LHOOK) CALL DR_HOOK('SET99',0,ZHOOK_HANDLE) - IXXX=1 -! - DEL=4.0E0_JPRB*ASIN(1.0E0_JPRB)/REAL(N,KIND=JPRB) - NIL=0 - NHL=(N/2)-1 - DO 10 K=NIL,NHL - ANGLE=REAL(K,KIND=JPRB)*DEL - TRIGS(2*K+1)=COS(ANGLE) - TRIGS(2*K+2)=SIN(ANGLE) - 10 CONTINUE -! -! FIND FACTORS OF N (8,6,5,4,3,2; ONLY ONE 8 ALLOWED) -! LOOK FOR SIXES FIRST, STORE FACTORS IN DESCENDING ORDER - NU=N - IFAC=6 - K=0 - IL=1 - 20 CONTINUE - IF (MOD(NU,IFAC).NE.0) GO TO 30 - K=K+1 - JFAX(K)=IFAC - IF (IFAC.NE.8) GO TO 25 - IF (K.EQ.1) GO TO 25 - JFAX(1)=8 - JFAX(K)=6 - 25 CONTINUE - NU=NU/IFAC - IF (NU.EQ.1) GO TO 50 - IF (IFAC.NE.8) GO TO 20 - 30 CONTINUE - IL=IL+1 - IFAC=NLFAX(IL) - IF (IFAC.GT.1) GO TO 20 -! - WRITE(6,40) N - 40 FORMAT(4H1N =,I4,27H - CONTAINS ILLEGAL FACTORS) - IF (LHOOK) CALL DR_HOOK('SET99',1,ZHOOK_HANDLE) - RETURN -! -! NOW REVERSE ORDER OF FACTORS - 50 CONTINUE - NFAX=K - IFAX(1)=NFAX - DO 60 I=1,NFAX - IFAX(NFAX+2-I)=JFAX(I) - 60 CONTINUE - IFAX(10)=N - IF (LHOOK) CALL DR_HOOK('SET99',1,ZHOOK_HANDLE) - ENDSUBROUTINE SET99 \ No newline at end of file diff --git a/src/etrans/cpu/internal/set99b.F90 b/src/etrans/cpu/internal/set99b.F90 deleted file mode 100644 index ee2a2aff4..000000000 --- a/src/etrans/cpu/internal/set99b.F90 +++ /dev/null @@ -1,81 +0,0 @@ -! (C) Copyright 1998- ECMWF. -! (C) Copyright 2013- Meteo-France. -! -! This software is licensed under the terms of the Apache Licence Version 2.0 -! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. -! In applying this licence, ECMWF does not waive the privileges and immunities -! granted to it by virtue of its status as an intergovernmental organisation -! nor does it submit to any jurisdiction. -! - - SUBROUTINE SET99B(TRIGS,IFAX,N,LDUSEFFT992) -!AUTOPROMOTE - USE PARKIND1, ONLY : JPIM, JPRB -! - IMPLICIT NONE -! - INTEGER(KIND=JPIM),INTENT(IN) :: N - REAL(KIND=JPRB),INTENT(OUT) :: TRIGS(N) - INTEGER(KIND=JPIM),INTENT(OUT) :: IFAX(*) - LOGICAL,INTENT(OUT) :: LDUSEFFT992 - - INTEGER(KIND=JPIM) :: I,IFAC,IL,IXXX,K,NHL,NIL,NFAX,NU - REAL(KIND=JPRB) :: ANGLE,DEL - INTEGER(KIND=JPIM) :: JFAX(10),NLFAX(7) -! -! SUBROUTINE 'SET99B' - COMPUTES FACTORS OF N & TRIGONOMETRIC -! FUNCTIONS REQUIRED BY FFT992. -! BASED ON SET99, SET99B ALSO RETURNS VIA LUSEFFT992 WHETHER -! FACTORS HAVE BEEN FOUND THAT CAN PERMIT (OR NOT) FFT992 TO BE USED. -! - SAVE NLFAX -! - DATA NLFAX/6,8,5,4,3,2,1/ -! - IXXX=1 -! - DEL=4.0E0_JPRB*ASIN(1.0E0_JPRB)/REAL(N,KIND=JPRB) - NIL=0 - NHL=(N/2)-1 - DO 10 K=NIL,NHL - ANGLE=REAL(K,KIND=JPRB)*DEL - TRIGS(2*K+1)=COS(ANGLE) - TRIGS(2*K+2)=SIN(ANGLE) - 10 CONTINUE -! -! FIND FACTORS OF N (8,6,5,4,3,2; ONLY ONE 8 ALLOWED) -! LOOK FOR SIXES FIRST, STORE FACTORS IN DESCENDING ORDER - NU=N - IFAC=6 - K=0 - IL=1 - 20 CONTINUE - IF (MOD(NU,IFAC).NE.0) GO TO 30 - K=K+1 - JFAX(K)=IFAC - IF (IFAC.NE.8) GO TO 25 - IF (K.EQ.1) GO TO 25 - JFAX(1)=8 - JFAX(K)=6 - 25 CONTINUE - NU=NU/IFAC - IF (NU.EQ.1) GO TO 50 - IF (IFAC.NE.8) GO TO 20 - 30 CONTINUE - IL=IL+1 - IFAC=NLFAX(IL) - IF (IFAC.GT.1) GO TO 20 -! - LDUSEFFT992=.FALSE. - RETURN -! -! NOW REVERSE ORDER OF FACTORS - 50 CONTINUE - NFAX=K - IFAX(1)=NFAX - DO 60 I=1,NFAX - IFAX(NFAX+2-I)=JFAX(I) - 60 CONTINUE - IFAX(10)=N - LDUSEFFT992=.TRUE. - END SUBROUTINE SET99B \ No newline at end of file diff --git a/src/etrans/cpu/internal/tpm_fft.F90 b/src/etrans/cpu/internal/tpm_fft.F90 deleted file mode 100644 index a836d5ca1..000000000 --- a/src/etrans/cpu/internal/tpm_fft.F90 +++ /dev/null @@ -1,30 +0,0 @@ -! (C) Copyright 2000- ECMWF. -! (C) Copyright 2000- Meteo-France. -! -! This software is licensed under the terms of the Apache Licence Version 2.0 -! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. -! In applying this licence, ECMWF does not waive the privileges and immunities -! granted to it by virtue of its status as an intergovernmental organisation -! nor does it submit to any jurisdiction. -! - -MODULE TPM_FFT -USE PARKIND1 ,ONLY : JPIM ,JPRB - -! Module for Fourier transforms. - -IMPLICIT NONE - -SAVE - -TYPE FFT_TYPE - REAL(KIND=JPRB) ,ALLOCATABLE :: TRIGS(:,:) ! list of trigonometric function values - INTEGER(KIND=JPIM),ALLOCATABLE :: NFAX(:,:) ! list of factors of truncation - LOGICAL,ALLOCATABLE :: LUSEFFT992(:) ! describes which FFT algorithm to be used - ! T=use FFT992 F=use bluestein -END TYPE FFT_TYPE - -TYPE(FFT_TYPE),ALLOCATABLE,TARGET :: FFT_RESOL(:) -TYPE(FFT_TYPE),POINTER :: T - -END MODULE TPM_FFT \ No newline at end of file From 048527f88f2c398627513bd4f7272c44b283556b Mon Sep 17 00:00:00 2001 From: Daan Degrauwe Date: Thu, 5 Dec 2024 10:22:34 +0000 Subject: [PATCH 17/25] removed PROGRAMS option (always true) --- CMakeLists.txt | 4 ---- src/CMakeLists.txt | 5 ++--- 2 files changed, 2 insertions(+), 7 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index fc1e16580..a67b9edac 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -160,10 +160,6 @@ ecbuild_add_option( FEATURE ETRANS DEFAULT OFF DESCRIPTION "Include Limited-Area-Model Transforms" ) -ecbuild_add_option( FEATURE PROGRAMS - DEFAULT ON - DESCRIPTION "Build src/programs" ) - ecbuild_add_option( FEATURE ECTRANS4PY DEFAULT OFF CONDITION HAVE_ETRANS diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 963d00090..677880f18 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -7,9 +7,8 @@ # nor does it submit to any jurisdiction. add_subdirectory( trans ) -if(HAVE_PROGRAMS) - add_subdirectory( programs ) -endif() +add_subdirectory( programs ) + if( HAVE_TRANSI ) add_subdirectory(transi) endif() From 73111ab1ccc5f2aabd7bb4134b0d8d25de90ac48 Mon Sep 17 00:00:00 2001 From: Sam Hatfield Date: Thu, 5 Dec 2024 16:27:33 +0000 Subject: [PATCH 18/25] Touch up etrans tests --- tests/CMakeLists.txt | 45 ++++++++++++++++++++++++++------------------ 1 file changed, 27 insertions(+), 18 deletions(-) diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt index 76a6b4b86..9de50e0b5 100644 --- a/tests/CMakeLists.txt +++ b/tests/CMakeLists.txt @@ -201,11 +201,15 @@ foreach( benchmark ${benchmarks} ) endforeach() # -------------------------------------------------------------------------------------------------- -# Add tests for common call patterns of ecTrans, using the benchmark program -# This tests CPU and/or GPU versions, depending on which are enabled +# Add tests for common call patterns of ecTrans LAM benchmark (i.e. etrans), using the benchmark +# program # -------------------------------------------------------------------------------------------------- if( HAVE_ETRANS ) + # Set resolution + set( nlon 48 ) + set( nlat 40 ) + foreach( prec dp sp ) if( TARGET ectrans-lam-benchmark-cpu-${prec} ) set( ntasks 0 ) @@ -216,42 +220,47 @@ if( HAVE_ETRANS ) if( HAVE_OMP ) list( APPEND nthreads 4 8 ) endif() + + # Base arguments -> nlat x nlon, 2 iterations, memory consumption/pinning information, + # spectral norms, and verbose output + set( base_args "--nlon ${nlon} --nlat ${nlat} --niter 2 --meminfo --norms -v" ) + + set( base_title "ectrans_lam_test_benchmark_${prec}_${nlon}x${nlat}_mpi${mpi}_omp${omp}" ) + foreach( mpi ${ntasks} ) foreach( omp ${nthreads} ) - set( nlon 48 ) - set( nlat 40 ) - ecbuild_add_test( TARGET ectrans_lam_test_benchmark_${prec}_${nlon}x${nlat}_mpi${mpi}_omp${omp}_nfld0 - COMMAND ectrans-lam-benchmark-cpu-${prec} ARGS --nlon ${nlon} --nlat ${nlat} --niter 2 --nfld 0 --meminfo --check 100 --norms -v + ecbuild_add_test( TARGET ${base_title}_nfld0 + COMMAND ectrans-lam-benchmark-cpu-${prec} ARGS ${base_args} --nfld 0 MPI ${mpi} OMP ${omp} ) - ecbuild_add_test( TARGET ectrans_lam_test_benchmark_${prec}_${nlon}x${nlat}_mpi${mpi}_omp${omp}_nfld10 - COMMAND ectrans-lam-benchmark-cpu-${prec} ARGS --nlon ${nlon} --nlat ${nlat} --niter 2 --nfld 10 --meminfo --check 100 --norms -v + ecbuild_add_test( TARGET ${base_title}_nfld10 + COMMAND ectrans-lam-benchmark-cpu-${prec} ARGS ${base_args} --nfld 10 MPI ${mpi} OMP ${omp} ) - ecbuild_add_test( TARGET ectrans_lam_test_benchmark_${prec}_${nlon}x${nlat}_mpi${mpi}_omp${omp}_nfld10_nlev20 - COMMAND ectrans-lam-benchmark-cpu-${prec} ARGS --nlon ${nlon} --nlat ${nlat} --niter 2 --nfld 10 --nlev 20 --check 100 --norms -v + ecbuild_add_test( TARGET ${base_title}_nfld10_nlev20 + COMMAND ectrans-lam-benchmark-cpu-${prec} ARGS ${base_args} --nfld 10 --nlev 20 MPI ${mpi} OMP ${omp} ) - ecbuild_add_test( TARGET ectrans_lam_test_benchmark_${prec}_${nlon}x${nlat}_mpi${mpi}_omp${omp}_nfld10_nlev20_scders - COMMAND ectrans-lam-benchmark-cpu-${prec} ARGS --nlon ${nlon} --nlat ${nlat} --niter 2 --nfld 10 --nlev 20 --scders --check 100 --norms -v + ecbuild_add_test( TARGET ${base_title}_nfld10_nlev20_scders + COMMAND ectrans-lam-benchmark-cpu-${prec} ARGS ${base_args} --nfld 10 --nlev 20 --scders MPI ${mpi} OMP ${omp} ) - ecbuild_add_test( TARGET ectrans_lam_test_benchmark_${prec}_${nlon}x${nlat}_mpi${mpi}_omp${omp}_nfld10_nlev20_vordiv - COMMAND ectrans-lam-benchmark-cpu-${prec} ARGS --nlon ${nlon} --nlat ${nlat} --niter 2 --nfld 10 --nlev 20 --vordiv --check 100 --norms -v + ecbuild_add_test( TARGET ${base_title}_nfld10_nlev20_vordiv + COMMAND ectrans-lam-benchmark-cpu-${prec} ARGS ${base_args} --nfld 10 --nlev 20 --vordiv MPI ${mpi} OMP ${omp} ) - ecbuild_add_test( TARGET ectrans_lam_test_benchmark_${prec}_${nlon}x${nlat}_mpi${mpi}_omp${omp}_nfld10_nlev20_vordiv_uvders - COMMAND ectrans-lam-benchmark-cpu-${prec} ARGS --nlon ${nlon} --nlat ${nlat} --niter 2 --nfld 10 --nlev 20 --vordiv --uvders --check 100 --norms -v + ecbuild_add_test( TARGET ${base_title}_nfld10_nlev20_vordiv_uvders + COMMAND ectrans-lam-benchmark-cpu-${prec} ARGS ${base_args} --nfld 10 --nlev 20 --vordiv --uvders MPI ${mpi} OMP ${omp} ) - ecbuild_add_test( TARGET ectrans_lam_test_benchmark_${prec}_${nlon}x${nlat}_mpi${mpi}_omp${omp}_nfld10_nlev20_nproma16 - COMMAND ectrans-lam-benchmark-cpu-${prec} ARGS --nlon ${nlon} --nlat ${nlat} --niter 2 --nfld 10 --nlev 20 --nproma 16 --check 100 --norms -v + ecbuild_add_test( TARGET ${base_title}_nfld10_nlev20_nproma16 + COMMAND ectrans-lam-benchmark-cpu-${prec} ARGS ${base_args} --nfld 10 --nlev 20 --nproma 16 MPI ${mpi} OMP ${omp} ) From 5970b5f95e858a446710b2a822e6f0daa321d343 Mon Sep 17 00:00:00 2001 From: Alexandre MARY Date: Fri, 20 Dec 2024 12:54:18 +0100 Subject: [PATCH 19/25] fix extension of ectrans4py/gp2sp_lam4py --- src/ectrans4py/{gp2sp_lam4py.f90 => gp2sp_lam4py.F90} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename src/ectrans4py/{gp2sp_lam4py.f90 => gp2sp_lam4py.F90} (100%) diff --git a/src/ectrans4py/gp2sp_lam4py.f90 b/src/ectrans4py/gp2sp_lam4py.F90 similarity index 100% rename from src/ectrans4py/gp2sp_lam4py.f90 rename to src/ectrans4py/gp2sp_lam4py.F90 From 57b660d2bb5d2120685f548af44f58ee541569f4 Mon Sep 17 00:00:00 2001 From: Alexandre MARY Date: Fri, 20 Dec 2024 12:54:55 +0100 Subject: [PATCH 20/25] clean MANIFEST.in --- MANIFEST.in | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/MANIFEST.in b/MANIFEST.in index 1e1af65a5..7ee26d232 100644 --- a/MANIFEST.in +++ b/MANIFEST.in @@ -1,8 +1,2 @@ -include AUTHORS -include CMakeLists.txt -include LICENSE -include README.md -include VERSION -recursive-include src * -recursive-include cmake * -recursive-include tests * +recursive-include cmake +exclude MANIFEST.in From 7f0a62db219385a57f818d8368ca90c42e8a8db4 Mon Sep 17 00:00:00 2001 From: Alexandre MARY Date: Fri, 20 Dec 2024 12:55:27 +0100 Subject: [PATCH 21/25] label 1.2.51 --- pyproject.toml | 20 ++++++++++++++++---- src/ectrans4py/__init__.py | 2 +- 2 files changed, 17 insertions(+), 5 deletions(-) diff --git a/pyproject.toml b/pyproject.toml index 6ff8e42ee..7e06fc5fc 100644 --- a/pyproject.toml +++ b/pyproject.toml @@ -1,11 +1,23 @@ -[build-system] -requires = ["setuptools", "wheel", "scikit-build"] -build-backend = "setuptools.build_meta" - [project] name = "ectrans4py" dynamic = ["version"] +description = "ECTRANS interface for Python" +readme = "README.md" +requires-python = ">=3.10" dependencies=["numpy", "ctypesForFortran<2.0.0"] +classifiers = [ + 'Development Status :: 3 - Alpha', + 'Intended Audience :: Science/Research', + 'Programming Language :: Python', + 'Programming Language :: Python :: 3.10', + 'Programming Language :: Python :: 3.11', + 'Programming Language :: Python :: 3.12', + 'Operating System :: Unix', +] + +[build-system] +requires = ["setuptools", "wheel", "scikit-build"] +build-backend = "setuptools.build_meta" [tool.setuptools.dynamic] version = {attr = "ectrans4py.__version__"} diff --git a/src/ectrans4py/__init__.py b/src/ectrans4py/__init__.py index e28b7acf8..224c30c45 100644 --- a/src/ectrans4py/__init__.py +++ b/src/ectrans4py/__init__.py @@ -15,7 +15,7 @@ from ctypesForFortran import addReturnCode, treatReturnCode, IN, OUT -__version__ = "1.2.50" +__version__ = "1.2.51" # Shared objects library From 8ee92003fc36d5834dc942c359d144f5a7da77d3 Mon Sep 17 00:00:00 2001 From: Alexandre MARY Date: Wed, 22 Jan 2025 17:22:53 +0100 Subject: [PATCH 22/25] add tests for ectrans4py --- .gitignore | 2 +- tests/test_ectrans4py/__init__.py | 0 tests/test_ectrans4py/data.py | 307 +++++++++++++++++++++++ tests/test_ectrans4py/test_ectrans4py.py | 55 ++++ 4 files changed, 363 insertions(+), 1 deletion(-) create mode 100644 tests/test_ectrans4py/__init__.py create mode 100644 tests/test_ectrans4py/data.py create mode 100644 tests/test_ectrans4py/test_ectrans4py.py diff --git a/.gitignore b/.gitignore index 121365d66..fd987e6a0 100644 --- a/.gitignore +++ b/.gitignore @@ -8,4 +8,4 @@ build/* install/* env.sh *.DS_Store - +*.py[co~] diff --git a/tests/test_ectrans4py/__init__.py b/tests/test_ectrans4py/__init__.py new file mode 100644 index 000000000..e69de29bb diff --git a/tests/test_ectrans4py/data.py b/tests/test_ectrans4py/data.py new file mode 100644 index 000000000..3bc561884 --- /dev/null +++ b/tests/test_ectrans4py/data.py @@ -0,0 +1,307 @@ +import numpy + +lon_number_by_lat = numpy.array([ + 18, + 30, + 36, + 40, + 50, + 60, + 72, + 80, + 90, + 90, + 96, + 108, + 120, + 120, + 128, + 144, + 144, + 144, + 150, + 160, + 160, + 180, + 180, + 180, + 192, + 192, + 200, + 200, + 216, + 216, + 216, + 240, + 240, + 240, + 240, + 240, + 250, + 250, + 250, + 256, + 270, + 270, + 270, + 270, + 288, + 288, + 288, + 288, + 288, + 288, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 300, + 288, + 288, + 288, + 288, + 288, + 288, + 270, + 270, + 270, + 270, + 256, + 250, + 250, + 250, + 240, + 240, + 240, + 240, + 240, + 216, + 216, + 216, + 200, + 200, + 192, + 192, + 180, + 180, + 180, + 160, + 160, + 150, + 144, + 144, + 144, + 128, + 120, + 120, + 108, + 96, + 90, + 90, + 80, + 72, + 60, + 50, + 40, + 36, + 30, + 18, + ]) + +zonal_wavenumbers = numpy.array([ + 8, + 14, + 17, + 19, + 24, + 29, + 35, + 39, + 44, + 44, + 47, + 53, + 59, + 59, + 63, + 71, + 71, + 71, + 74, + 79, + 79, + 89, + 89, + 89, + 95, + 95, + 99, + 99, + 107, + 107, + 107, + 119, + 119, + 119, + 119, + 119, + 124, + 124, + 124, + 127, + 134, + 134, + 134, + 134, + 143, + 143, + 143, + 143, + 143, + 143, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 148, + 143, + 143, + 143, + 143, + 143, + 143, + 134, + 134, + 134, + 134, + 127, + 124, + 124, + 124, + 119, + 119, + 119, + 119, + 119, + 107, + 107, + 107, + 99, + 99, + 95, + 95, + 89, + 89, + 89, + 79, + 79, + 74, + 71, + 71, + 71, + 63, + 59, + 59, + 53, + 47, + 44, + 44, + 39, + 35, + 29, + 24, + 19, + 17, + 14, + 8, + ]) diff --git a/tests/test_ectrans4py/test_ectrans4py.py b/tests/test_ectrans4py/test_ectrans4py.py new file mode 100644 index 000000000..0a17f550a --- /dev/null +++ b/tests/test_ectrans4py/test_ectrans4py.py @@ -0,0 +1,55 @@ +from unittest import main, TestCase +import numpy +from . import data +import ectrans4py + +ectrans4py.init_env() + +KNUMMAXRESOL = 10 + + +class TestLAM(TestCase): + + gpdims = {'X':54, + 'Y':48, + 'X_CIzone':43, + 'Y_CIzone':37, + 'X_resolution':1300.0, + 'Y_resolution':1300.0} + truncation = {'in_X':26, + 'in_Y':23} + spectra_data_sizes = (2592, 1968) + + def test_etrans_inq(self): + spectra_data_sizes = ectrans4py.etrans_inq4py( + self.gpdims['X'], + self.gpdims['Y'], + self.gpdims['X_CIzone'], + self.gpdims['Y_CIzone'], + self.truncation['in_X'], + self.truncation['in_Y'], + KNUMMAXRESOL, + self.gpdims['X_resolution'], + self.gpdims['Y_resolution']) + self.assertEqual(spectra_data_sizes, self.spectra_data_sizes) + + +class TestGlobal(TestCase): + + gpdims = {'lat_number':150, + 'lon_number_by_lat':data.lon_number_by_lat} + truncation = {'max':148} + spectral_data_sizes = ( + 33052, + 11175, + data.zonal_wavenumbers) + + def test_trans_inq4py(self): + spectral_data_sizes = ectrans4py.trans_inq4py( + self.gpdims['lat_number'], + self.truncation['max'], + len(self.gpdims['lon_number_by_lat']), + numpy.array(self.gpdims['lon_number_by_lat']), + KNUMMAXRESOL) + self.assertEqual(spectral_data_sizes[0:2], self.spectral_data_sizes[0:2]) # dimensions + numpy.testing.assert_array_equal(spectral_data_sizes[2], self.spectral_data_sizes[2]) # zonal_wavenumbers From 2e145ad1231bf9bded184a12c379134ed4f5ac36 Mon Sep 17 00:00:00 2001 From: Alexandre MARY Date: Thu, 23 Jan 2025 16:31:24 +0100 Subject: [PATCH 23/25] add sp2gp/gp2sp tests --- tests/test_ectrans4py/data.py | 307 ------------------ tests/test_ectrans4py/data/__init__.py | 15 + .../data/antwrp1300-s1t@sp.npy | Bin 0 -> 15872 bytes .../data/antwrp1300-s1t@sp2gp.npy | Bin 0 -> 20864 bytes .../data/lon_number_by_lat.npy | Bin 0 -> 1328 bytes .../test_ectrans4py/data/tl149-c24-s1t@sp.npy | Bin 0 -> 178928 bytes .../data/tl149-c24-s1t@sp2gp.npy | Bin 0 -> 360128 bytes .../data/zonal_wavenumbers.npy | Bin 0 -> 1328 bytes tests/test_ectrans4py/test_ectrans4py.py | 87 ++++- 9 files changed, 96 insertions(+), 313 deletions(-) delete mode 100644 tests/test_ectrans4py/data.py create mode 100644 tests/test_ectrans4py/data/__init__.py create mode 100644 tests/test_ectrans4py/data/antwrp1300-s1t@sp.npy create mode 100644 tests/test_ectrans4py/data/antwrp1300-s1t@sp2gp.npy create mode 100644 tests/test_ectrans4py/data/lon_number_by_lat.npy create mode 100644 tests/test_ectrans4py/data/tl149-c24-s1t@sp.npy create mode 100644 tests/test_ectrans4py/data/tl149-c24-s1t@sp2gp.npy create mode 100644 tests/test_ectrans4py/data/zonal_wavenumbers.npy diff --git a/tests/test_ectrans4py/data.py b/tests/test_ectrans4py/data.py deleted file mode 100644 index 3bc561884..000000000 --- a/tests/test_ectrans4py/data.py +++ /dev/null @@ -1,307 +0,0 @@ -import numpy - -lon_number_by_lat = numpy.array([ - 18, - 30, - 36, - 40, - 50, - 60, - 72, - 80, - 90, - 90, - 96, - 108, - 120, - 120, - 128, - 144, - 144, - 144, - 150, - 160, - 160, - 180, - 180, - 180, - 192, - 192, - 200, - 200, - 216, - 216, - 216, - 240, - 240, - 240, - 240, - 240, - 250, - 250, - 250, - 256, - 270, - 270, - 270, - 270, - 288, - 288, - 288, - 288, - 288, - 288, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 300, - 288, - 288, - 288, - 288, - 288, - 288, - 270, - 270, - 270, - 270, - 256, - 250, - 250, - 250, - 240, - 240, - 240, - 240, - 240, - 216, - 216, - 216, - 200, - 200, - 192, - 192, - 180, - 180, - 180, - 160, - 160, - 150, - 144, - 144, - 144, - 128, - 120, - 120, - 108, - 96, - 90, - 90, - 80, - 72, - 60, - 50, - 40, - 36, - 30, - 18, - ]) - -zonal_wavenumbers = numpy.array([ - 8, - 14, - 17, - 19, - 24, - 29, - 35, - 39, - 44, - 44, - 47, - 53, - 59, - 59, - 63, - 71, - 71, - 71, - 74, - 79, - 79, - 89, - 89, - 89, - 95, - 95, - 99, - 99, - 107, - 107, - 107, - 119, - 119, - 119, - 119, - 119, - 124, - 124, - 124, - 127, - 134, - 134, - 134, - 134, - 143, - 143, - 143, - 143, - 143, - 143, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 148, - 143, - 143, - 143, - 143, - 143, - 143, - 134, - 134, - 134, - 134, - 127, - 124, - 124, - 124, - 119, - 119, - 119, - 119, - 119, - 107, - 107, - 107, - 99, - 99, - 95, - 95, - 89, - 89, - 89, - 79, - 79, - 74, - 71, - 71, - 71, - 63, - 59, - 59, - 53, - 47, - 44, - 44, - 39, - 35, - 29, - 24, - 19, - 17, - 14, - 8, - ]) diff --git a/tests/test_ectrans4py/data/__init__.py b/tests/test_ectrans4py/data/__init__.py new file mode 100644 index 000000000..22793e116 --- /dev/null +++ b/tests/test_ectrans4py/data/__init__.py @@ -0,0 +1,15 @@ +import numpy +import os +_here = os.path.abspath(os.path.dirname(__file__)) + +lon_number_by_lat = numpy.load(os.path.join(_here, 'lon_number_by_lat.npy')) +zonal_wavenumbers = numpy.load(os.path.join(_here, 'zonal_wavenumbers.npy')) + +antwrp1300 = { + 'sp' : numpy.load(os.path.join(_here, 'antwrp1300-s1t@sp.npy')), + 'sp2gp' : numpy.load(os.path.join(_here, 'antwrp1300-s1t@sp2gp.npy')), + } +tl149_c24 = { + 'sp' : numpy.load(os.path.join(_here, 'tl149-c24-s1t@sp.npy')), + 'sp2gp' : numpy.load(os.path.join(_here, 'tl149-c24-s1t@sp2gp.npy')), + } diff --git a/tests/test_ectrans4py/data/antwrp1300-s1t@sp.npy b/tests/test_ectrans4py/data/antwrp1300-s1t@sp.npy new file mode 100644 index 0000000000000000000000000000000000000000..6095a7527af0e722ae10c88b1fa835f4c4c357fb GIT binary patch literal 15872 zcmbXJWmHw)_Xdt4h@_G#C@P3bied-OLyHm;0xFih?oDk_xc^<_Zj!i-Q&D@_S|R9z0Z2~Tys5ho&Y&zS^4|BNUTU~xpZ{RwV!ic zW9JgmyTZlK&ZTGa+~WCT<3}dXb#(uq^OBDZ&2@Lqn?HGMs=I@^1+QMZ!q3Cc{)+wo z--DWVC56E&$V8ar|HrX(VS!Imx`KE&%h|Q+OEKa9UZ&jDEG<2rLAWK4kwQ5iE#V>$4=FJ3aHu-6TLV0R5y`2{$IO;S?in3nY(8R1bG>|Hh~-e z*G_Us{M=W=H(JE8qOfw3YUcmg>AgZTVcO>(T7Q$F~y2HADV8KD{Q>8C}g`Br!kG zN8?QTAOGx-Dt74A0b-1r&d;d*%>VIUndkd5;2}4WL~Blp{z27${F98uHVzrH5=r*R zakh=J{Ac`$?b9~ofqwtSeW1v?xldf}A2up!w)2WJAZjtOe{Se{Mu@ffG*@bFMUYXH zx^AmsMU*hR=4r96N~E4FQ=wHI!A8y_%B8&qgg6GX)Xbyb;b+F&b@J-7MDR0NzxMDP zvG(Q`ozNpi!tqNEHqUJo3CuNZqRf%2AgmwKvE|c&yBAMGnQ9yGGUohjcN8aFDT|z( z*j~bX9zwa|HW`7rM@Oz}lY}T%^0p<8gPhR2?Ky1T@Eb;R$Ud(VCqVH%-=&*s{De)V ziW{`!op6!p(`J2{lHdxNekIb>gz=X=6zbWh2>k4d7X-eYB9K_0v;1tE0UCMH2O>17 z2@c}d)_xu@fEOinG6(sO69zWO8zOT)LMU~L099>0k`T*#KK4Yx_$R-VTU#{{`Lf!u z@&FZK#4<;HG3X5t;|2s}%MTE4UU(z-v^@vT3sJFXz7==+7Hm_ zDEjRk={od#&0fwu^ci|7zXnpiokA9on-6C!$s7+A3xJ$fCsV<^Bw}wak zn60cYNE3cXD~`n6?FM-ZV&ZAp3&gdP9m2CGE)jESXwsSog$M!>aZB5-LWJAzO$11n z7eOWFf-_N+jd=QzI6=YrGf<@)tSjeSB%C{%Gj}`iGxGlxtABI#C+xE}-Qat|C$Js(nZ6`g9TS+C(%JP!>78U2+GcNY|?tO5z4NuO5VMk z4b#0jxnWeCTZ|x63{pk|<#D}{H5*ogVY_XvLV%5y2_-de9 zs6c`DL_U0uRsVaHVG~pzT&Y}K{Rwmic^#KEGvU~YiA(C~DWL7)74^P25A602C)H?; zg5pp`r&>}G$ep%LjFk+)7`IAT6G4m;Ra@fOaw3P0|oW6%mh*0AGK$XC!+D6 zJeT(;sfqHjqZrC`pbTTJ@gk!qK7Kt{vjD{D#VW6{ z9GKKHT=8w@B&Ir%#cudcfW6>KVCrF7LitCjyP9&1P`uhj8=?FWgEuzUM@D9GCV`Ip z`{Pw$wd2^Zo8M2&PpG@6XkCd)Lm^rD4;EooInQslz77EB{bNiaIK_{F}h1Vz);z^GQQIpwWAQzSD=y@{Y&jq$GqfQyvJO781hvGYs2oJNf z`uL%pe#?1l<1JkKo3cx7Y728lJ~c^D&cXbFazBYZvv5A4%`u155A&jk^dFagV0iq^ zyr^Rtu=io9$QSuZ5Sn29b?ABzo?fNk*cH$P;%l)q>Rhc&7sv}9vviZJ z20AOR(qB(&P}Fv8?jB(dZCl39r1J;jp42$)kUyV5?&y6Uv!Qo5E-@AOK4%nPu38vj z;VA0tCUvOE>Vin?n5`j;4&c@c+&;=;i-9I*vnR}}G0LT*=k!`A)(?^mfDjl zj02p6V?xz8`tO_~p7`U&bFy#@n{OrCRf``X*0YLIH>6DCqj^2Q`1qs535E_7uy`5~X@oWuQY!2K= zYHx&6vigoDzCJwf5Y2Z`xf4GxIaOYL`Vr&>Xf@|&sEJ!2Oszcj6k)paYdewoANWaV zo5V!I8&00zts@vhP7GH0tv*e;hiG-(usPdk2K}QuD5ErIaF4+76FCl7T>j>J{>3B- zvF5#V>l;aTOj2>o*~c@6`^;iK@`&c3YT-uIkCk8`aiACsBM-w|U$awdDX!=pU(eXG zzKUiysAYA_Bk-P?b|o^^V=$T8Vq{7Pc1Qjyxaqox)GVwcR)lY8SVAaQ_RPnIM-+pp zxuw|TY$o?(!5lJjEo*`}rtsWNgTs+b&TwXM&pGZB3CPv7i`q!23@^9DlQ5hwgLhQR zWWol4@Ze#Qh+l&PG6xNA%^n!Xr=t(T*3_P$;jyb^`Onh8yh^x&{DUKmqz*D{3HIPK zm+U0As91l@4EWr`(W$oy2(SJEUOJR5b~--YA?qs`F9&F9W=vRgXs zO>zw8eR;~zn`aE)dJpyX{|ScZo8Cp0Ov!k8pZWo(s0>*5duA55HwyxIZGDQV(vhCt z|JdV`<;cpQXSXVU6BN=Ud+ruig64ccg54uKP|+>Zvg+RdkIzBmyX`zC|F@5~wtY|f zO_YH+lT^rj;nZG2d4l=K^4J#Av8Npy2)p)3rs|3 z=B0pr)x-Gds#C5@BPH?Bc-@&3Q#8cY&~7{WaY|xIR|;KJJq|Gp_JMDnou3zJeH_ zxO(|%Q(iv2zZj%>z`h85Y5C3@B>g|Sh8o4?E@wOnd3@JQ93kWsHAC)_|~T2AeW zVFr+{bM2|7cR*EA#?r;dNpQPl;`jP_1cmuN?at&tXt zpOFJF9kr1c{_zD!s~TSs>vu$G>-BYI3&fz=TxY|h-QekVikbqtVK5G9&hG33Nl1)U z>5^?=MvlTax!f4ka!ps~Wov*nW<@gRZ2%P3ZEGs$J;%aVj%5yBH6U|kBUO4=4Titl z?HF(^4MsIgeS-Lnpqyy3$#iKLjvr??);?qb#}AS$RnVqGm*E{>r-o?IyzE=JRoVp` zWt~|ohr3`PkZZ2&N+@vCbUSMYz5{P&i#OIBZXhRi=p5Np9<&BBD7^Mh0^M5{%tN#R zNd2YAN^7_YCTU%5W=b1Sn(mQqfJ!0I-bhn(d~6I#i`OYh+J~WyR;i+9`U#lbmS*C= z@;`p(jrxCTY5X6*?|i1DI`Wp4$bKfX(A)GNp^au&!Sfml;+}N-GebSQ2z1QTmN#0d zh<5F5Nna=ivC-exacYH*D6Zg>&f7bL?FHZx&`>~tvLxm~)x$ZNu)b0${ElW44MTXH$ zILDE-aunm3o~-3_b>pj}`|ee~@4>a+`4cj!v0(6q^W&fAotThxZ{cfgI5-zNn7-Lr zFZmOM#?~7vF*Tv^pzu~TRGFV|+Z$U4nFA3ryw9ufu(IfxcHU5}uzDiCL2Um3un91w+K**Ih;z@x;I8gkhM8dcdqH-L&ais~o`7fP}@Tx^w ziml^n4ZSEN-4a;$zzO)}Y=5b!d;#uUQwf%FPgn~&$Td==xN0!aP#vR zRI`;uW_pjoVa=iThi_fsx9%o?n^qBCEk6>)UE>E0@yZdeyF1}c<<>ccI|XPZ8WU`? zR0Q_ogw(F3Hn>$;OTQG_f^+KJY_>gZSSc0%e4yP0gI37)Ex_&!BmbkW$ z@2*O`^7F5bt3froc#_5)(jS5XFLsTC41YEbOdaD5Od% zepx$&5Zsm##J0B(X)cM?wxpK88*+*3t`^-8YM#@)YSD?eLQg+A^syOdzw+Fo?0XK= zV$!?riG7A9z3I0tWoA$#{>J>lj(+w3)m;Z@y=rBi{Ey#DSN-T7zuQ^=|5)g)&rlFn z(gNd5m6(Zl`HVZ0D;Wq9f*N!Mj~4NzdXbaRL^}#muV=35Q4yDx=%&0aKjENgq1f`f zww?QYF?%>U5qCaEu<$FYMd-xVa;~DjlqeVPQzEnt*+-ev4TG$)!U?lqO^{!1aLe1F z0|R(w&umo;;J%P_DVD1v5KBV4hbpojb*Hy32J832Zw}=cxr!NF=qk~u8hM7t#8&Dr zlJ%qQ2f@s2hYL|Krx|MF88AoZ8n?Goy<1uymC9hIRE|QqVa|rQz1AT2d z|8QJ4lJvz~NqL$8!Y$U*LH6+wTLBiO23?qY=T0GSQYSF>Km2L-q!_sG>%Y)_o`DXG zanY4&bND`s!t~(<51eVyUR!uK1XsqW_gu)f05Q|`rJRCE9P43O_BWlv3AuwYd&@t9 zzy23;kIFtE$!7TZ-M|5iP9`o|QhY@173Y19{c&*GgHYjH(g~!A4*Quon-RSjEROXy z!_T5wI;Lk;u&L~}+Pq$fUk`S~n>K&Jo5mNa?!+BI%A-%|Ux|-G_+Ti-CZ7+y`Nh2Y zoo*Brha1P`rABd$nTh6EbRXDQpVGJ_vE$z%@yyT*8SE`6+cKd_N3qRjePx2r!S)!DpyahkIbuUuUw*Zs5lxp%=JrrrK9KUq7 z78fke?>g={v$OvEzYq6&t@e*f{>NvntOEnJpS!_l#*2ma?J&BITS$InpeA1B-fDDd z*+U?loKs(z55Rs-dOz_=j|so#ZXj zPbadj6R0MK9(nh);#v3jz+L>kKsCDm7zc3@-G6CZ+_nxviPJh%7b-uZ6GLlOV2BGe zh4?FTOMk+qq9>m>i-%FQ+P%0{sv1owNjztI>QJ4wjneF#CDLa(3Y(X9V83eJw(^%y zNSw5a2vp9(kPTwSrdAi;JF#SKcCHgxO^qbaMPwuWr{u=mC%HiRMbx1#Z~>=ktnXNJ zd!PvQ@FhW+RJ5bahPX?naGQOIhV%Gm^t$;>Fva0BP96>;^}X>NuPGPpyF2v`uVjUD zXpgAkg`@9W4y6sE&lKBIk**iKSIuX0s&l_Lzp z>b>yHaUNmmb6vO=zscIG-GxKFcW17hi~}m!tU=b8Xh`8~Ba$y)24j&)AKt1wtWrt& zBumf%2FJ0y1P^D()r&lJ;Zi+L_*1aFT&;s_JCk#4bP=F?GDQ08%+7x1@ZUnY?aqJv zwa;a!Nbvvp50~>ZWuDEL*wIH*<>bw#F|^l9@kvY-GM+4-{5V^H4iD8G4mQs~okdxd zmvJuMS^6Yjf2V&ZFH`xtvXfsG98@N=XZi$8Izn11RsHaobMe9C&3-6;{%76MwgIAD zJLC?wdjjW!=kzm6eNYlYk%VfOs3S0ypcsQyt!`2}?&oL4$~u6VW* z4{~fuwtjAe9xm@EBU*h}JKxSed+$9?UeZn|F=)ktyN!M$wjR)=Dm{K+Uo&RiHm=z2 zXh-S0tI5HYh}PXs3lArWxHoggto?&0#JAh+8?`9L)#Y~{T5sNfbT7H}O0X?D+0CTd zsCFXd@{KdU}s5s8) zrEK*Mw|r^+9rF9oVnJ)y3IBe)+xeGMl%W-=jA(k!Uu(xx&SP4NF_zGN?6&d;nikwG z{mF@6*8!U2cs1{;)T1aPYvdEld_19b|AC-D2p5y+}BgShxJbmR#Z+BgreKF~Dg(&Sk zNS85MgiI<2RLPcHAh#^>Ze@-Q%$-`C(x|cosa@af0q_BXniV_}mjZ%Cpv-*#(`n+_9`EtAe;gX+s zk`8LG;LC!?EOzGeaE9;wn#HcKpqmn5n9%YS`CfRXT%+v3irV{)VWlnDbL;wv%7GPF zP+=MS zJUekoVIY*VEE;d99{hY-F%XPnd31sfOF&i>8G}T12A=QvF*A3bh-a7fzoCpxg7k

pO1okj40O?v?fj*q4~y`?tv*7$aPFUq7=GUvqd3I)V#vIVgd8>>|Qj z*%zOM9urZ!V$YKHcLW(uwQD(>ZO9)|nHZz^7FYOG39F8^$TfeJ!~B&1++OVU?8_)a z;g`AwRTQgQX6r*Fd9T;RVGS#c|%07!}9%MY&Rq0p&i9p$oWEV+E-D)+iB=G^y9 zdikRQUSDX7wQYC;^d9QoeaCZg_GflBJ}ScQAxgE+r?TO^!qN2(lT3)opB>)U_YPX; zZH+lzzench_eSqOvxmmVtgkoL-s0nzg(2TeVzB-4gHb{IBp?rLV%adQfRvG1%kcZ9 z$oe$@_u0=yXnvZQN0&X>3{h`1V_<84f$VuH8XlWbO!Q0D!TM{_6MT1GDP{E_;y~hB9}@0~PM68Ex%h{4PKm=rSLVDv>lzzf`NiC;rXc@zZXYTC6#JGQ9zF)SR9Pb9SQB zKDNIa!A%hHyZ*?_#Tp>FR=^NE6APaE?;ZJYEe$=dZa3~{jsq~ z5X;IF#Z%9ggW%eL))R?vboNeBzt)rv8vJ7KY5I2R(gEyt{iE*qw8tX-+^1;h@A~qn z-~a`VQ*O~NXdwI?l6$qxVQSk` z^6GR5Tn*P28`uAUEU6WKC#I^AZp||FV16wyovq-rcCLb|Kz^0 zss@tNhN!znD)D?q_VD&{54wgl|4Jm9frezuNfGltcyd}+@8t4Jn7&wU(Hm2T3;UVp1M7(2Frjy8=+xy_&9-crKs zImTb8YNIczai$Ix{wzeWR=# z)GynP498SsU(B-9Tb^n#>6Wa!lj)9E17qKf@FYXCng>z$0bb@+DcO+c8-o)N- ziO*=ngPazR0a4~pfaIk?&Fv?dvY^SH2);H zYd`}(n|&o64GDpilI3p63O9WCBi%9RRR?|x@DSW9(gBY=))}<@G9e(Tkiub4JTfQn zOjK=-WAD%}J2O>*WYz4we&~)dJin4ay;r0Mm8-9%wWRf+gJX9qXMZk` zixU|l#k1k|=e(Ua>xU4D8)0#CE=u|<3$JLg?pw|%KBN=;R zCvUwSW>HXL(S@yl92(BY7XW{mnVXAO9$1|FGu2Wv^^b3UoQ^Y>N{0U7u|PMUz@TXi z#0mndz&mWZX_L2h`ozj3E$@sM zU|aoe`+xG zP%yN-{6i+GREBFDNerj%AO@6D(aabX0`(R4su|H@oOSn|eB@NLlaJLVyZ;))o1InE z_vOPd_~_U3G{@R8S!CNK&D|Fd9*{X2V$*{*8e9g|t-WY|bM0xNLj@}5J(@ATUyaLT zZl$(2Zvn|s%A%gNO4MIBeSY@xJ8(VlJ>~S`2Yk@;V}Gh?EwcEC75x>hhAvm#Kt0i1 ze7)i9swz?do5p1qvyXj5E2ZaKCCpw(av?v8U{;HSdD@fD$PIumd)M@>*z<%H=-&37CPx#Y`NmBK#DTr_5(W)G$wG= zuI}*m@-HiTY0g&YrB468&p8_(_=)q{?eJ)6{-f&kvJtc{c`6y%YlG>Rx(QbAcJ`-X zK^ArApMy!{-)!Z8PP8w2MEj1h3zx;u%ei?KVFAted7fiM=xLs-((+s#&RI$Gtv40n zX70_^Y7-^ceKh~2x^pttf;F`U!C6a^Q~Mwqwm z{)msHh9cgD*kIjrE${no1xP|Ncq1-H6gwopuH@)9k*{aDknFpodpye+-iH3fwFVz;l-ojBfB=1g|7 z3QBKGKVy!Y#r&Swd9uJNT$iPMd2C_UT9873suh=B6OpJWaPs_ok2`$s|u8{ z-O*bMOl~zcOkowTUssx9@Qxm1%4K}70=@an_p68)z!nXwGp)rC-j+YHo8Pqx`{)~e zzsXj>v7kjwhPMega-t1PsiUDMMP^rEOc$D5$`&yZiN=u0CnJk9-T3y^U8)df7wma- zLDFKd3@J!he1C*jBTeqnTSx9RAlKyxA@BG`Jn?gK`dpg}P;8VJ+S=N{_3aP_vq4k1 z{+hlw`)D2p_%U{68dhL^?$6L1&N8^Zw?5Jb3($qbMz&h85E2e=Tikxygk&=N4sIRr z$G*LBd;AYH;TXrCx$nyg@cdXc74@wg)bBPLcX&{YP8;cm*Ca~t&9@ILA{)i%dM1_q zk%lLHxZ5!3v(rx&Q>w;u*;xcPTJlrZc%H+33ad9_RFx?Gt&q!Du@dG9k8i9=mg0ek z;%{XsrSJtO!oKOWp}+^fx?A_0(5Qau``EJ&GVdGen9_B~vkc@nByTZ9K*zIE@u zpM_9e!5Yz=0~}-1{JIjl$UPtgoreE0kC_lu*T zIx53Zw3CnXC#|WwiB+TV4=E3msRh*5=Kk}rp#U{Vm{r1mHh|p0rag+ySzwnPN+#|% zf;2WqgDe-vF~s4t*{plaPM!N=sQW@E1cOf1)tx>N5-I!Nk+I#_v8u=JLRz=8KfA9G zIaCdH1CXc2n}$^~@7z|D5`cyLp?k+A#Bb{RO>Fg|&E4!0#wz59c>a+^N%21{(_~2A8A0|Eo!Xo&Kx*Q@w$kf%%}%{qCrUp)<6p zpKbe^rH$u~B_E_nF2IZPeLU$T1;D+aQ}}v+7II$~G95I@2HVZ6btY+LIJNotTM|_e zy6jmw#-mw`U$PD7&zV@FvOgW$qX{o$UD3*)C8Xlk#Rb8d!hoHkkowi~oS2>ZSPbRx zpFpTl_~EK05fA$7ODPX8yX^QEEZF-z8U`O79Mdw$!6W+9jtc>KP;rTe^>}d-8XEFU z<-ARUuN>D+&U`J$aCNEF@F^!eGIf-2l`VfKZuJ%Q)+nJ?W25DYb`+*Z`lnCErlZ0v z6K8Q!3Odr|S3kP4lW%`9QB_Lx2a>$-dk@8!>2KL+{alD0p&E2E#XIr5 zR_X8_&O&JEO!msqD}dH*X7+5zLtcT?QBhM>c+F&=`Rg1ttc`7(^IIr~LaKe~y>mKn zz;<_=*5Lp6^j=x_sa@;%KYo!Pu~Xup>qDN$-U7;tJADJ}s;RcM^Y}pZuvM7q7w~DP zuH%&J1!_l@;M=#0@YcywMP=qw=(YGgn}?zVlP9B+7q|Msd~cdkd36`W7toy!5va#Q zrgfP1^QVVNrTdj*UIw{fYjI*l$}t!3lTES;OGY4rZ-R@&<8qvRQ(;xZ6O6Opn+;BX zdI!CMRO=TG1Y&l2?w>P0ddRiz|EDx74()<_7o6F>;Ls~Baz45&7z*5felf-mm~}N5 zrQDOjL-~ZI@V-JkZMxCv@HrotMMX3gEfUa_g8g|*eiD@6sVBQ1R^xf<^IoL%e%L5B z^}wV&1jnehDr1khU?!D<1}A;mPJa2;Z1Q40Dtv0E$S90}n$?BpCk<5Lulxztk6rF? zB=bJkgW+I!eOohdn<@bIC94K;7)L{NMQ%K0TQO$bzwi4qt^_K)#(YSG&%%$x$~hW` zz2URQHRHIAdUO&!8f>R*i&88Fm$;=o!1GajRsNVJ5(IxWi9E}~&k+M`pQiIr{exos zSy3n88vJuX%E|%F%%Wd2p)-iZ-dUGW%7dE*-#Je>`hn)ERRcjQ4dpb0)9+E&;}Vsl zZDw~ptlf1S{E%M+a|0^JpL*r(tdqhrk84`~@kOWRHidQf|JFaX_fBPWMy;Uz%P_u4 zsRx-!nO}-3d_;4f89u(~F1Vs~(a^qh9LiID8W>HJFe`i4-XI4=v*Sus+I^|`M`J65^UT;z&KxO+VrVxq*dE$6Hv?q+C;YVeA4MC-g@(=0sA{- zkYz8Sn90DNq{SmeYFT|~OEwJ@TE#J|tLZkjk zfwu*fK)Xn}M*24dC+clNjW5JOX_jCH!_^Mlh&?1rsrmvYSS z)Pvo<4RGz~edqJS4PeS^CvfV8Bg7MQIk_A7gXozori;A;`C zyt^R57M=&cIeTsZcNj*rn8>viN5Fmu30*Vm7?h%)q22xwh$>t(H(rO!<6~LMfmXCVi2k$^GrV8|_A3#??%jD%__fk) z_OJ>Vyb#R!S{x1Zg#3p=KMK&5gVUw{TS{bNg{6|2) zAqU@=7;pb#Psh-?=Gtt%G(6I8CHNab zo2lQ_BLi|F;?j%kNplM*eq}mV^d=Uh?Fxykir5C=suR%K(HZ$~I{3Tp z)PeZBYLlgS@^}8Hpq^3QdjUDQnlo8^av=QCAcLbo5!w}X-Xb*Rft&WOS&6n>lwo{j zI5M6MKMK_Y5`%KkH!eivu$UVPOROy_9Z5nHM%m*G^QK^N{Y<|rxjBfME!u_QwoZkDB=@pMQK5ffCQ?8&z>bi=V|?Nts^J-w<`Z(hL>p%-&TA<@ja6?Hf>`74X?f?Fd5=FUsQx3;|EkH zCFRWDJ&X$XO<(QdtU%6MQPpEs<8b-nTNcKeXxx=FCv|)$Ut3`$724Kpz!AwO-=p;h zL5h{4a_-efFpuykA*{QBE4^T|;=miY&6yG%?CA<8kN5Aqw_~r?Vhg%97eSB^8O~s^N(*lR?4Zgnj+57z|-+cwZF~ z3l}6+a+_e_-+VP!wTFD-s{M!eJ+tKf-aLxxqPNZb8hXJ(Mw27nunzlkss6qqDTgB4 z9LM30(>O0>XCBs`hfWO?5oX#AASTS}G9?m+ME+KX3$Od}&tocdFF%6))(=hX9a~Vm#gw}#+7Yh4*ZZVNtcSLE=i+NBd3fY2W$M$A z6zC5ArL)xi0l!7f>U@ulg-3m_eLohr?d+fKeETI8jL()|8+NB80^#h1bn%^jqg|4v zGSu>wSZznaa-F0GOUPa&Hyh;uzhIV9t6B=sq%yrB{&)%jjxQq=A7`O!@qX$7eFu2J z&Bgh1A{RmoWG6oKXJMdab}wNt1UUwZ=%v) zDPE&+{p|z$u^(TvwQbQB4q~D3hV6`VHBt>Rjb)vxK`TkmiP&8{*ymzMnbOgUX3J3Q zo^u1)Wu-XUyvuN=-!!poG#i=hP8vBEB!J%S3QY|YYwTY$yBXAG1fpd}o-%l~;$0fY zkAemMSbvA-PrO?$4*X0>y_lkc;(X)@zWkNQ^;R<8?MgL{yznt6$xFc-wyR=(5vdr? zcX;C5xI9=7jC9q|1(yxw;#+u^p*{|c-=-w{ZTuPG$ZXIdKIR|8KUe?XL@d00L`X>L?m%+8rQ@hAk$Nv4ElVUdl z70-V7hkrjE7P#_k67znyx@2k(fL8-~(W$~5w0)+>UbvP73lDeWq5XsCyl47R_tjGL zy5RV*+IS2vcX8C-7`Mj#6eLt%tV>aYEH09JCr>wieZ1^5c|V4@H;It2_2ZMpg|{bF z9Kj{Wtu(R56Zc=074yAlfJ&G3{?h*G#09!QQC;;SlsjZv;ANQwr(N}kDCGpld{?Dz zjJV;7{-#R*1QER?&bA)%j7A&o>5YZrN>ofLGflp)0B3)<85rY zAt@9b&T#qXmaQgbBOEF2u~f6a4lk3YcbVzz=*k>T+|?|l7@ZiKkn%JSB(I-knUnXx zI}3--DkmDlIkFd<^>5?xXljJc?6*jKJv?A_TfG$Tw$Qqie6_`3OOgl0(D84+dx957 K4sO@|!~ZYDK^{Z^ literal 0 HcmV?d00001 diff --git a/tests/test_ectrans4py/data/antwrp1300-s1t@sp2gp.npy b/tests/test_ectrans4py/data/antwrp1300-s1t@sp2gp.npy new file mode 100644 index 0000000000000000000000000000000000000000..d5d0f3e1e3accf70f494b64dcc813908ef9c2fcf GIT binary patch literal 20864 zcmbW<`9Bxm+Xrxoq!b}p`-n;+QTC-&)+`~}Q_3!~MMDG_(viP`Fdv;4`;yx$Mj*&CMrkDaj|u z&1ZSl+11(1;lfpCa|^Ow$?S@Y1=hP*n>kuw`GBaTAh(z(zaY0a_y6;6i);Ar$bi7B z^7*A#bZwzYn&cG&n8tF4OA*ey^Z6Ww?2JsIywIptvz8f#9?joE1K(P9{9X>YDxZ*H z_hSa`O)knEg%8GT-hP9I*#+%i;K{emC0#J)@gBQRkUBo*K_{dv&^%BJ483jz$Z-}Mp`g_ zOm;Y@)TLzoAUuOFX_b24ltwGOYyOntFU6t2qVy{+(!ryPb zb%j%=;@2L+%X61pbv0!vXdkFhA%S&p)L1`^qr) z3x2zK-e&+>S8!eLg!Da@;`OkR%SfjZYRY|iT?|dPC5Y!iVYc?lY`FI2v~MQ-Xfycw zDHQVDW1j)%oY|GKU=mZ?R4!~9Y=2b%`F?EjD<_`+piv8V4Gs9T!8zYYO5fnk{a@>+ zp{&FkHcFK9Q}E6QX1{8cG{w@*rY?&=DgV)4k z-hYGcQ6k+`h}X{}fjx&{py7v6eJHlPTzCh{$iDC?fPD%ITqE!>|LS!RNyEx35AUmA)2bNEtjAIfMLCJA^nw3M3sjhYTrSh? z$H5z3DG<`W4hQC1zInpi^Mh7onb+lT8`-W*-OrsEqqzqvn`Q~g!lR;wW=7DT zSQSahpgX~vrQAm(aPAKhVJG2R#jkGlt&iPS5bA2tgl;F(;?|ZYkJnt!f=t*^TyDi zw*0#}{5mpr#}WD|u2A^EV@(!8p>R1Y^EVln!~}%jAI$WfXWsHOu1kyUl{#KkmzwKdfVY|O6bP1#BJp(UGHHn{sjJM-nNx*0- zv&%xzNLhqtKkTPFY(n~n2mc%!2V{LTcZ7^5C#ZaSSYY*U)ff`TW0nB|?2s;z{?~5U zcI3{)UigES>Wd)!bF5(t$=|t0j)NSpV`+OC8IOkO(!<`SgLkG%snrT>|!~b3h$i;TJ z5z;26)hxkLmj8_TL$AtL92XQbfvcOJONPTWM+KS;XhF&JFB7`)b;KmV4dX{I_&{^+ z*&X^&FYNnHKA2ZH<+gzQ#R+0+XYek5<7A zr9ZD{LJzH=>jMgD~$7*xKd@*Ngsotqwj331-x zgV1}o>G}`&*|k4<9DdEsJ39+&oMg@{LoS;-5o#RAsX6X1BMdx$NpTNssJ^iO2&4?X z`Az{QSjXlV!L5nZpPk@n&Kz|JTu)lrnE};LbdJ}+`i`k!a(=joY^k9^9FIoQ*9t;$ zX+wdtklr=+?+v(1RCkfI2T%5h=qH#YE?}}L4DGGBherzT(fF`g7bg8Q?K6TdD`y?G z;mWIeFG;vJFEE$|4qo0ZHHH0YJ!lfE;H4imjuDXksE6fJrgor!t*0Lv z7sJ{8M$<_!`VU98Kis2Vqk9ErUhn>L4rW==tIETR=j+8u`TgwGYFVMec&g53c$|)= zWfAq{X^f%%2^HVPn)JdsU5~A;u+{cJcr9#uf5rL@JpZ*Jv=~+l8Bx51CR9rjxscvY zru7+|J!7>*jG=vYjEpm_&b!k{x;;&fy<|Vz&ugzpKcxDP@pK)W)pIfKgz|=$u6~EN zXbh!hp>kEa5+%wPnVA{R0?+2q7LoFM{JO!f2n(7|xtT)a!@?q@9a^cK(&M4d6N8@D zQ0(JJ(|-7%j6Pu_;_LO-%ithXXya}n?V)V2X{R47?sv7#gId`k4g>Jx^sbxBkkP^5 z(}r-2PeY5(SFk+%*+<|fwA%UgM0^)urGHm=--gQD_gpi8S)b*i1Ym>t@<9sN zN%_vC8|C-Z_ocA8IY~U~Pg^Ft& z($`^-iDG~ooIB2t;tU_VcfWFi#k*=hk>&A^emlwbt9~>4JmElMo&QZJH|g9M0LwD{ z-jMva4jzn5fiIP7-sZp$bZTqm@EODViWV3mqAoKGzi~HtuRw*(B?(NZmz6kci4d%L zb*fYiHZF-S+Cjy))IOn5=HDOxm+(vM-#=Y&Z11sq|DbWNf%rkRN4fQEpaGm6r{N5Q zwJdqpp1{L3T48yRrut0zbC@I(sQ(B?p4*)g1jAFiE?$8_j8AAa;O3s0cL$*Gg=7uV z&hh6c#d^r`SaWUj;pH6~->k8|?Xc4qlD_8qRSr>jTKGUHJAAcY=O5Wm(eRncIMVy- zOZRp{f6l1pN;per9GnBSRn$5XpxnDE<{)_W;7*(C@MM+w-z)G~wwm%qC~hxVdk*U4 zn>ne&ux00yicoGx(f;FbTgn4=8MyhD!8jQ=nj6@Jh)R0n5@eit^7DwREcAW$Fq-tI zw=ch4QGtg%Xd}sZbH;>C$pof+dd_JBSEz50De%Iwdas)_(D*^w+$6TUe}ARl z31?Cxua?8=*~JIx(EkvBc{p_a?C|XdR1sTpBkjKL$M$4Bc%);}P6@K#WGR<`4?pfx zA^p&Yy|i~X)+frqJpP1R4$Ny>u&cTpNt>tLyTw0xKetiOOqHP z@T7sPZ#p*YOwzTV-6T(q{f_WCkJ7;}8|92x;KWH=B_6VDW_t55ycS4x^*HqGxWcIo z=SQL>EnrwsyY+QwQY*k81)aXcDCR=i1ULQ$xXtBA(HOk{Il6}yaj7t|W(;9}NqUE% zp%M7Y;`xgXSS;jmxeU(8JPS*K1{8fBH=$Sp&zlQSF>^?V1^e^w6RTaq@)E^$<$gF9 zqj;$r{->>@kp(3yrEi2oo&nRWYmnJiiO~!miXNj-hfh*=3rWKGfr9RRaK_?t4-*V> zxu3HUp5jb0e_B3Eqy7kEuZ2g~z*mekm6h=G10BjY zuzh9P>pC{n`Pfr#aq4T|< zt1n>4gB+PC$QODq+XK=Fn>U(5vs1M;N^o~_MywE&^`7--g%-E0VoAT@o$)oB1&1NGqq#rZgRn+i+4Fgu%WSKuhR)B1;Vb;m;gU2MeBm&`$niPgec(m}(okWS7aY7Coa7(;d8tSQy3GIaapcU2s=a2Qr{Lwnu06dD*s-&RurOY6mC z9+G82wf}CzV>%wK73I_3F5UbC-c}3T+6p<} z`>2<}G@I3k49IY2;^+eyc<_$8KiuHE(&`4!?f5xP`p=Kf;s_E4-g=W=+R(z}t&j@5 z;QsTgJZ#igJud@!mIquVV5`x1gD9L4F@Hy7Pn2pChjZ+^vZNuGV!*xQur%RjHR)H( z7N;uCz(ekphU7TOd^V?T;KIsp5l_hNczkaV%n?Z{B=J8k&~>-~-b|Lh@)1gG?VTd^ z+pt8fLy3BqY&A9~@w+9%>U09K3aYr6L!o~b>G$C3M(?CN$kp9u(F$)Ssd4>;8j`9b zD{$=Y4u#E8SLF}>zO=L*zT5pXjUJ{rr_Ph*rmS~OWcvV&JhQ%E{vbQ1-&nwh_)xouLIv1!QT3CUDD5fY@6O91)nhT*&H zN9Ld-PsE!g=vujBa0Bv_-LQ+64wfE%T)GSXy~sJe4|4C~Y7&F$14?u%aEsk8M-#X= zc5jjkG%UKv9Re92O@u#%ZDwr;t0D8YgXadJ+Kt;gs1P5o_YJiNpaGxVrZZ4rOo+}A zdj3AN6bxO4pEEs%3$*9P3t=+HCC+#7lw68`Jl)j`oc;Rnkh zEjM3h7PMGCyvZz@+y@D@$U~*0&8~Z3#RDDAjnGTI3HTTbfX*Z(l zNIP>TeOmE=1smf2GlPYb{?ex**FSrIQJD0oRh1iVl7Gm#4ep!{E+XwNpJ2W|K{VmB z?1N$vYrdpEIx)I()k6L}N8vKqlby?10B!Usf^%SnjBHB=jEdU3BORvr>uq}i`49dm!-q>$xDGcjrQ$MT1EYUVI3;1ApTIn_nDI70KgJK!qMr)v#Q1Q|jWTGt* z+k*IID+i<=fERY(VON0W@81gfye-~CRKHn4yeVsBULZHgS zGx>Mm1>W-p*C6NhDdoctFivm1pS%tJ%@(EcP|QN3&zj&!P1OHw${U>I z3au{5i5tT0t?PBipb&Fdz&_Y{eEjA%C`#$t^#|oHd|Bf79j-7L<~6})o#Gp1FnQIB zIU8=axiAqAO+}BklYUsP6@B_9?5Hp{aD~iQPiWi0BF!D{m!UFc=+X1=1oM_E16Z~Y zlBfr5pAQHUmro@h)`uTj=2DE{OIPaP3$XnBkseEUI_UY>Rj6;IDRKjH#XndIfC}|| zlCe-ocpxtmI&4gfCjEM**2$?It|kAj{|VoZc2SUi{LF;q(tmI&-GhzP|Kp3A6Bpo~ zUS5S;(EZrUlj-pJoKop~=(_17=LlrB+wp-CaTc}yGsyuJitaCy`13i{e?9^8qWMZR zpqNASv<{@0Wi!=+fhY8a6d+&wUB?yprj1X#2d<<{uD^nG4|tkmA;9u2 zl-g}ZD5gjV)tl zs3)}gX{Krgx&6L)>%ki`!dXgig;5SK!DpvSk)twtVV6431 z+Ez&E$j`qSZk}~++yoag0&WpG>kehoz{So$VUkX-Az6j&7bBp~&IY9)d2;f?XL{xr zg`la~o(>sUywr714e}Oz`g0yWpu2s_8H!D=YX(A*d9}!g@OY&6>T4(!F<9{#p1&|* zy$Ge1x~{My9_$&M4@sQ?Q`E5TJlBhl zr=bj+%4;$ByE&bU2YNLPxYNUsyN!eEsPCC)>+93-WZ7@)LAdtQbF>SFlowexLfc($ zj#Wddabb&c_;{=RjaN`R%K1hi^eJu2$cOejn12xC^*XC#RZ3ySo|ctLsNJZj zRR`;uEn3^4|E%ljeyCMM?MKF!-V(F3YfvoV<~;_KZ+XMdsJ&3%WMx%zZt z(@(C#(|?B2LgB_1n~S;7FO!3!9foim7g>Vkg7sQ^5I3Q#Oyw#te4O)>J*4`qq!9*F zX~TEs!nujud$mxPhH+mPoKNwm?1T9w;&R<^sQGqcSSf zMXNpIH$pj|__aZ#FJe?bRSiQvnY2EEG0prJ1K^I=r%v0!U%j`!oq@{7XQ2VnplTUQnDhC}12UAxPnIZH|3806_QZe~JU zg&%AAO2eYOsEP|Pruk`z56rmt^>;L!d$HjC5Hfif98QI65*kA1;t*G6tzcnD-+W(* z4!X&*^8Lj2_K4%vVS z=)8qAw0o6v@(>J~+b_WbV;ye9utH0v*N+&WcDi-Z7AU>pvco2*QheycMo266U^kI9 zf}xBG=4Vk&)4-gnS*dN%b$3S&8F%_GFvgL7b@;)MAV0KDI}j!gpZK(~DZz19-uL=Y zQBJgq^h>+a*!zA^IDFTOcz8-vSGo|sJ3RKR6_y6XwEZE=zkbK^A|3`5Y>B$CDx#q1 zF7(wC2zmwWPS6JrLz=}Qbq2)!@|>ls7#xjoPtt}j7v$>A;J=m~bmnk+c))=z9`%lN z44=cYhw5dGX2?Nze^)mA?fuT>E|d~p=OyXq+7n)$geTmD4)egaV^6P9!muobwILi= zIN*aVY2UCCKD%r<#G0rc4(H_N%iW-V?BV<8A+Ku2Ez-`LDQ(z=AvLS)K~A{E#KxEw zb~Ds2ETX0eoq{-`YY{LB}~63r&t1npJTRo+2nE`F_2IO*_j;3XWkm|S}X6%Hq= zXTt1|DgCFAOaIUY;^McDLS%g<{q0){$R^K+^d>*u>;E zRSqA0;-OE0>q!}VZ^D|0$1g~~h#9$TqX;hMdQU;wj-0uDhtr?D8Jc77J%2@8QgFEl?cO=2UdaEln z&?xl_Wk0;KtUEpe@9g)umzaR@$=18d1#S`5zNilSGV4z6hbc^^?oc+|Kw2Bz24`nkewLXJGT(6+9BzbF*f>^NVzB)!he2+{(n!Yyn}g^ zicy(RQDqQ{vBp^w6U6U1MPM)%3~ z73NkNlHU6Zryki~&3rANyjIMRXMpa6@Gm-|F#p_|Ggf?hbdC|82wmQ%M0FcoeWJN@n4fNe+uJYe&RGt#CUP4|ELJ$`+Yu(7BW8ImL0e%?+bys%@S@mH9RFP&b6-8Qar*c>8(Qn_ zDGr4U-CdJTFzu;MggzXdN_-&)8JiYVa;=BLeJ;-oPVfq%F6H^Ky{aegus?rOF z@(D^4eP5nE=?&d>1Z(?3Tchj6cVMncTyF@Rde0>n3%?Y2`ldmujywE$kYnL2BN@M3 zL<)J@VJgjkyri6?$6qS0Ldv4klKWAQ_D_!=m_m{I8*>j~S;djRV~|qj$chN!^>&_9 z&jUU+zZw1prbVbtuE4yZu6`l3L)Mwc6gu$9nXU>mC>L(?bY~L&FKlpFp1`tU(=YvZ zP$%-6bpkx4FEr~675WRdYruuNp(}hafPZ9(65c!TIlUkGYs7SNl6L)JMcEn;1+tqB zJmJMHe%}qDd**pgS@=(O++#OvVJsh{gxB~K|BRyiFEpj&n_)ElTxK!M`C|2g)K52m zW;z&p4@{QaM(B+-gF=m+bM`eBo3@vx~Nldc&kjDfslx_OA3tp25;voA)YwU0#aX;;w`<~>> zke|vR3xnes_nwA(6|`rJprK@$mji5@dj0J-yx*mL>IMARcX4eTu8p%)llFO)+huwa zPHCLp+yW`)U!CAY9P6}`a;@Ms(HqgvAT=FJ$q-Cs6=B_q_VL{P^9C1W)1g{yhFv8wBpzY=kGH;`V$+KF(!5Eya*ZTD>$98hS;aae(<2 z8s=)ygYkA7KfK3mt*{v`$PaM;MESnAjpsDL(Fvo9T$olcSQ!arZ5tA=!Ps9Vnx^oN z>-$h8*e4w?APgl+ciMBn7x8V>o8hhtQf_|`hrdxCb!1$BaeM4iH)Nzh;V0J>-1vx)^Jd0WB_s{7Z+^z2+mt)mz>AneaHx^OzjC@5zu& z0rZ;rwOj_7b{bH9fRQpX86EKP+WzT5c;3;$Y!0?3(;eP~@@=4gt#bsfr&!uJLYg=p znlgB)C3avN;?X`Y=6o62Mauh;IF?Dc=xj!OA5`CI*MUvn8Z{%Kd#gKJ1r)x%64VJ5 z>DVI!l2O0xx3$JFb=AN`818=hDP$8|SJ|rFhji~#vaS`u-CFKWp^(xyvE340NP1o& z5BZ+l5#@yDO|i!oaeVV&p|(y^4lQBI0(f)EE$}|PDo(ZCg;?*i;T-HONkWsO1`EUbERjMUdC#Ofp&$8UW%mx_W1wnwqtg0;uQFFQk- z?fk*!(Cc}|76Yi9{~=KWa#k_qD8MKkh2Ue5TWx-`6r`w={UHXISYN#og%(k(LgFxB zzZnPFzN!3EJ4rtjTP3LozXg3`BG&=dZq3^GDN3cFw#h$ku4!*Qhh=jhy#rLeB@a6T} z$KWj~50+i9wBmfiH1hA;d)l*s94GZZdUBp7?v?EHg(qg^+|I)yU(jbGQ&#sZ{Y?bIXUIobW=+oq3 z7_j}LEEg=5JothRvLEO?s#!Q26HWQ{HB`gFsb#r3xTPVguMrL(;HCHk#rl5a^h5bG2S1EMx~Ca~ zf1zFZ_j_bKsr;`_Kpd*@&L6!F&$w^9)CAAgdcHe|`iu3>{R)9+#y<{E!sFX@4yqxZ zH%{D0egqTQo6{zsaF_Pv9<+<9%4^o+P?>If#S9D-N>QqY^N(}CJ%IH*r@d|A(}NUN zB%S0bHKU!7O-A>}IP!^{Z;O5h?aRJiPJrhBF4&WPko>!#T^%;sOKv^@MWpWV|3)a;D*KLz^*oh1&y%4^-h+u=EVl@|-B zZ)bckXFnV_4YaL;2Q_jt3gPKVpP)2&#?3UdxpH8P>6%k^id8DaGttcKoLsPwUltd%3In#3plQX zo9~+zc#r1x?rfOKT_krG?)X?)cL{#gynXfrJXT+Dh8s?>Z~a06e;cb;45B_-LAHGF z;qVLZtZZ1@CwVsl_EefuctA$2y9{Qqor>$58Z7?ovRM+|Ww^As4=QL4i+;$0ZyH>Kh^%uN#fJfv9{BO8+hMeCG-gI2u@Fw@iaWal?y(_${1K#gF?oF19 z?=2a0!7tmL&3j>~IQ7m!_}TPy0J%?#sI%w#1EoiwoF~`$q~TXdM@TuW*K%&a_vs2h zK0}QwvODEb&z)BuZ+s3*`=WlaBW^z_xl8WA^Zg^%W6-(#yuKXbuV*{m?*)65ejj-R zJS>xh>YycCcscZu4>IerWvpPWWP1 zhtoLn*ErM1_70}@aT<|+VHH)Q&df4)IdL;e+e@zM;HxS*DzC zVBm}A6-iKVoNcQ&%ys6~xIng3vpzZrUuQ%RoCZn3q|0WLo_yh^UaPmi{6T!2YW zN*#=#k^7JjIUfcYi^s_ICA?2Hmn^e=i3~G_J0IS2B;&!ZUzBpzP~0y0s}r=n{xFn` z7cp=DW66W2qrS^)u)eqMzA4JBb}8XtBaGcdH%7)SHpyoy`EaqUp@SFkjOg|a424Rv zA1TIQ4}WLhL9~lUXO%u_rvk6S)-`yp_KJ85%;R9UOND+ja}JI$YV;`8Nw`g+{Kigb z>Gjla6#4jhiaD3VLn5ErBj87^Up1DnP}$pG7BWez#W2He>*btDlqdSBZoqqZgtoHx zA-uYw|I45_xWD)hsUrZnDfqgAWCrG<$N;$8R@jYO} z6=O1v91^6bcRxmg9?fyOKfM$J&>31|2c+_UpW;L}IAzvJMOb%UeMc@By& z>|N6;3-lP}x-)`wX$Fh;OJLZw@k>GQa=Ng=dFa-m{zDk%bTayEf@|kmC3|t)QRm9$ zm(Zg)`+6Wu>q-qYgKAbZF4B-=W?vCGKR4w!RgvrGx&D*AP0*5Vz3&+eHr`$n3@v6= zLax9G*(-N7VP97(`w?irXX4~8Xjy&Ra2;`&YDjrc?votjnF?EBoUeyx8O)~oKAH&= zUFdUSVa{Zw>^^Siau z$o0KO;Xg>tI1^_fq_ddpx@O{9DXeCOG3WI~o{sX`CIE(Tp@3TVh!zqK9tulyZd zN{1%)>3*KDi+9GD9KU9=v3f5YYuGx!O3KH0uB{XD)EQVlhXQ_|SV?>Gb+`(eLo>hG zM0xnSC(iXh*e>{7;2-KYp_M%K4IUnd+D^vZ&y&;j>F`0gv?giSt*Zi$$oTt0g=?EJ zRR8*+MgfK;nox+qtG5qkv)ljI z1%D>k)3ih1q(+-2D9Xh>K*qCsB^)ip2miU%ll~E2>dpEYp6V#%?1u}=5!MVijzrS) zJaafDeo(s|vLtP5JcD}8472lfz!;;17+u6?{`1OwFAR&Li8Ml7yEo34*1*`wg~FX^ zm(a~;;+0{p+N#kkJT2RpRS7R2*UAisZ!ghznn1_3m{9?^SD-&;1^XYl`KhS^O01vY zO@d6h5|8a+b-_>S6VUkhj1d#Ou5p)P49730i@#A0HPv>t-G^u2Zj7;krc+OEl5sZr zQs6EQc-z&R^AE~DI&N{b4R)AX{vz#Jqx^j;1RfiveRTy!KiK830fq4$i!hYglF&)U z-L>k>ie<#Z|C&bUclcha$*=(qUi~^)2xsK^zLIhH9{tOyaL67gc=jfYx;-i41lg2* zx-Y};FDU+z@wwz*g1#2~k*=pkuD@y&7vjl%RqL7p8|epu7ZdNFgzp2-d?)KSf3RLs zhSMX)SIIc=LnD9tU1%PfFHHKGa>6ABb(Hgz=RL7{m{eNVbQ<+uzjnsB0fvQ${WC?} z9?wpl{R!FYX$mhQ?t_(sqvcQ{B;)54RFC@UkoXw=#*{1m68!J2TkB!CEhy^u8n(wU z(Q-m`Eh zg4v%RTGDF`ucLe(O%s}3u)VSHWiG6`9BUK+kDPg6Xa*B$&U}`GeI9;6>@XnV&Z8yN z^JGZpST_vK()D@`+l!LdlAu{hYPlbL6`1kN3N|fs?I!)W@zm-wNjMpM-~zdx2di=l zGm!P)+UM60M;%6vo?kGJ$x&$l$|y)}`2^oi?TIAqeb-DlgWMNS@iY7>gU_O}sY+ql z&S;8aDEr4E=M|K&5C2pGtFpJ~zl8yQjTvN|kJU(?C*#FC|7UHF;Smv&G#1n+i7B=& z43=#abfQ6AIs{(MXTj_4SB{eNsF^ogr<3^Rwe=~qN47_3{XHmnAbd^e37+%489%=f zR&^;mHDW!xNLOn-3@B6Yu!L-$Gxv3M5)-7$B_Sz(@sBl{E(391?YNn2Zub2{Bb0J+}F+=y|Xt`f258-BxnE#!xjOIcV*RlN2Y#Wme^hoF0VF<6kqjn?bL9N22LnO|7 zQlCXgKrhjv%)@YLhh3%stUsX0%Lk)!z5izt&E*ub%*XlD`vBAlK4K>dMXP6&FTvz5 zjI4R^_mkRQa^FUgyEo}3v=9)coPbn}Sw3mT-eE^x!tBKxhANPj;_tKc=P$>n_&2!$mnE*rq&)N5<|;rnUX zkVPD4`!}ImbufoTVwxQHOrl546*x$lrY{e7Xq-0O3F|)96pW*M&7t<=Z{aan-q&$3 z;&$U*PpfxuJbqs{>91mEM(OWDkFU!$ zws0i&ihveuj$Y~~aTXaqpT-T(3T(N)6^@H8{#``B|MI)E{|98WZdfMg6K#cV^auDv zZ0i&`k9K_TJo6HMR+$ybhM_l{3ew=aezn3B7;S0%HxZ5-Hz_54Z{fEzC+~ybrc15^c7ARn1IqiFi2u5Oj6FFI*h4wo&mx`Q z%=SMg;joTq2`4Nv($6B}dK7cV61g86bzBdWGcwxWKTijpR81KX=H@XK?jz+$Yix zS1IL+A3=Z3q3~7s<9Wz+(!c%XS69gY=QbmWapeE_zPSxq63|U==^c4)=b=>HL4JqX z61s1?6z(@lJwobP(y4KXJddNf@=EFy)b{<{Lw?7}^71@Ko_q4&&L8Q3JG*+KUc&Fz zt6|~L(1*e5D%{xe@}w5LB%*3ges@TWD?P;mOE&RMFXML!XL{$C-{C*Ge{|$`PlIqZ z2J*W`oJjt)WO(@ibzTsBUbiWn{4S>VT3x^f{^J`LBELsz#-N07Q$XU2lW?cEH7EIf zOpZZxjQswds?qrV5L{aixpxr8JlMRSA1d#5e@Em{X+JIq$28S@Mc~sDcQ;AGp?yOS zPr!;->U&8320q8tjA5$F=yCFUemRfgojXu^L*yOuyUa7b?)~IQ@r1_8ze&&!YwC^w|{=zf!f|j^ugwnhr}edA_B7K3kSNXY1%2tsu`|rUKr4 zl|X*#+bN9p!p~|?D5)TG6Qf-}ekWCkf+HP}64Hk6hHywZ< zgihWkzng2vDZUuN@90z#QStAgoV3qyCQR7YTo??Mb9d=G!d}JxnRD>NV9#G!n4|qU zXdk?IU&)Rh(vX@A*?^%6Fdn)k(wyJM@O5Tt0YE+`kg|cH0 z#>o4ViVYjS#>3$U4>hCULrS-Aq0n7nemV&HJgASk2aPG1P02D_3HwS2oIcI!5eX$G zTVvwjv(7b-N6@up-{l-=s3sUej(23>5M4cdH~4X+2Y$$C|MUwE^lkH}A?2UjGrt!O z=SOT+g=ZZ)2g&;;w4tTOS&)fdTavtouqn1eloRpVDL3YK7IJRluYUmfkCn!^!L|A< zn~i9PSnF472jH#8-gQ#Yq^V6{9`DgjB(Jr8fd_mX#>?Qh@z0Xv{ky&0$4-&=J{MaA zALzln(LyD0xWd4m!2&abc(4A&dzC)-eEECflx~3}c^|W#f57+&%%2rr34*5@O+S+N zWG5_WMNMF-iTY>qK5y6t7mlOQOzLbEHxwL9=V5@$+d8*yfRi&D66Ww8bh49B<0#aK ziAn2&ZkZR)e}bDhtSia)0gkg&JPput&6wc>f3Ah`BmMB*!A-}=`__z}A4JG|$jAWr5PwkG&2;7K+Qe$ae-B zJsEliFjhTI+yy3n++rOGtvRF33!vmV-PRshbx3!Vy#H*Pay3C1Uh6N+Bkx20)j70} zyjPibi@PunhMKewlJ`qb1+rZF1;fQJy(aJFF6-TL*$itL&(4$g@|u@=pS{9+{v7|R z6Jy|As;~>!V5e2jIr6=dZm@opBvkqOBa{PLjf{E!!*?Hfo|zp(@L`!4eFHQZXiR$v zg}>9hjECV{W=3wq8EU86Q&llk7(A3=Da4~I)gQ#d-vr3HpxHL|-OHCcV zMbcApbD!CO{a@aDdtwXRJ8)v_PI&b0C2<~@yQK6@82U20UOfqSPdW>ngFpIOIqYCB ze|^O*$Q1gpAqo1`dD);uko#2K4$cW?``m}w zId=Z!dyD34b^pG?0F}3S%doto@&pt5hmD;NCkyNltlh;3@j@coCb&x1{c47!rw=Xd zf)D>)Pm9C%hZF^>@~*J9kLxS>UbM8`UQ`S!>b?!)fbZ2w$04u>PW$7Wv-2Mq6jz8NQTBe_#%8@Wn;zL*bqI8_D;}Q8S6h zPQvu+m;&;BGIv*c-cd-W{&|>u|81%75i1D4uZB;O@ACCO)G(6e5o$k0vi3xVN&ZwNXITwlmfDX;R)_+rD9Cor=|A#4r?S?k zCN1dyc{q=Jrz&&qTf;o^3w=g^n0$9Cc5Ope1Li$Qvn;E61e^3ep7)0uZ9fdJK%V25 z49~*0`gHDN(2G*E_5c)pxo-;#WO6M}*a%~XGhdN;S+@SmzA_9Ad93bs!S@H~9+CNa zm_G_lk$HC-7$wZed?g*n+L-c)84or*gQGHR|7AcnF3t)vKMRXvqx}EoY2lI!AnW%t z8fIog$K@Z-$$qDq>`O>KJ8sQQzlE z`5Igp)?zH7=>->8@?CsLNUDbbboRfeKY;yXSt9Sp!j1tKYfUJUuI57K%~;*m91w>2 zc~sv@rjz-DW*+?gMCOyqNxGy$=9>yV`0yDA6d03K*aDqcT%IgqUZ&9NZ`?;AeP3ik zH{328Eb4ewJShrKfUQ|N6aMV$*LL+f4?!&3W{#JBM4(pW$X^wap=(hn`3 zy{#nkMhzV_5v4+T`O^PxXNNwOhn7iwo~YZYs>8IQ?pkZeEcU69%%`MmE5(xuH3AC$ zHo$K6?e?>9<_~>5nSaNOX7^1pkIq{sTY3j5HM(_o3Vcp;a$7U(Ewt{YLVKETztJcK zZy%A+v4t+|Cwh6+$6 zE&J~YDElhxs614)l?@`xS@Ig1r(m>&*F_cRvF(?LCOmR3;GZ6B4e>p95$>yPDj>&O zOvp;T4xOuGuLi^Uh3iFRzP!dmvm5f^rdzEeA7J5@EC(`=oT}f8uoZYIBE5kX^_{M6 zEtZ6hZ?1+L!g_AE`(&OmF~y24kKw4+CVw)onb3^0{~s7_=9IY?@e-cBWlH9=GT4Qm zprH)=X~|N^rEKt>v@cH)y$?U)8`!jP${gOBSmX^yvZORMz{7?K8Fq$ qQ#!~zNe(QDjna@#>P!Kd?5qMqG$mwyx&H&`TRZRo literal 0 HcmV?d00001 diff --git a/tests/test_ectrans4py/data/lon_number_by_lat.npy b/tests/test_ectrans4py/data/lon_number_by_lat.npy new file mode 100644 index 0000000000000000000000000000000000000000..317b2bd3ced2b5c9d6fe639347dc2151b91689b0 GIT binary patch literal 1328 zcmeIy!3qIE7zgm#tAm3F&>YmP+5<{S&T^r>IB;QOMG5UnN@^cLDQ6Gi0USMo$8dH+ z`~P3Q(#plfTz>t(nbXWS-@esux*bcc)W!_`a1fZPHnmB`INFTn!7}h>y?HS7U-h~- z4gF_59D57@neAe^;N%^>)nBhvM#U=&bI^t*Sc47d!mhB7JcVmvguHv>0rjKsge*Oy zPA|yxiY&dMp5z_pq{@mn(g|wpf2xD?f8+c8^*wz0ZakON4+`%q`-wTJAGt64nVEf0 s&*)z&{}1yK=P3W-4s~gS`dY|;-$%VGbdej7bA@xpMxAqrbBS~60nd_D=l}o! literal 0 HcmV?d00001 diff --git a/tests/test_ectrans4py/data/tl149-c24-s1t@sp.npy b/tests/test_ectrans4py/data/tl149-c24-s1t@sp.npy new file mode 100644 index 0000000000000000000000000000000000000000..702d566ec83b0b6fdf115dc4c2efd29715298709 GIT binary patch literal 178928 zcmbT7cRW|`8~=qOi9(62D1>BhE_?62viIIwwuEdlvMIA7l!_}9r6iP;QC2CXG7=g; zzsKYEeSiM{z5jc?pRenT``q_A_qp!tu4`di|_d=i~S}f_~tA{{3XyB*CAWW}{>xG(_MN z6C!ys|K1aL-Ff4?T!mu<{$QHQ_W7?n1pOlQMQV}XD8bKmCylMj?!W!FSovH_=X*rp zM2TZNb~^V6@w__iU%4rV37Ux0?AfyLZGzrcAiR9psG1PZn^RwWr?!QlPc-%XO|R)C z_{TRW1iCi=+aEDyXV97P|BiRBbYJ1TYBV8UZH)C@r&1_E%bOq7rZlK0=;{uxJ`v(7 zg3iD9Uh4L(D*RvjZuBmQmvR5cowuiK@_bSV{*z)z8Pilq@Fz(t`kx!jBXGZ8RIjJv zDhc`nMeeb$cS8t%wDME=ljKd{?7;~Qew+X8->H?v!HDZWzxHKk$5(DGg!qDrN8HO8 zN6_{xlWvyFxrFU4pY`yPKmA|(PNg%1iE`!>{3WwPZ+BMz<4gm6uZn;D*M2K6=*`&n z#1Q;RubPTeIubaIl#oKN%YW_tr`b>`_QHStuV-eGp>ycJ@%2D= zZSA<^f7dItJ}K3#UX!qW$pbbq-xn1L+s{#byUr{mM9{=%+P8eZs1p3;Cx1{ov;KGd z5-2z`>SjscK}*6aOM%*i_y*l#(|3bF;4exXDc|YS5IE5p9rp^=|N0lPjoY5jS2PHI z@uP>rCywe8{MlrUl-|tx1YY^&nA(0PRRZrYQ0Yu7K1txT?Nc9uekc&MYC!T>47DM_ zui!do5?^IZ;DTMR_6m#`5V(QE@fc4pH3BzWc0J}bc7(uRmq)rb75vwJ%}?m_#N>?# z{5O|Mu53cavk$`@jBJ+P&93$LPQ7vpgF5gM7${5YPUvdjH=BWy1c1&+2ka zeBdJR_U%N{t}|=h|GOVg-fB{7@FtQ!q4?T|-@h4{XDFyO$Oo|1!2LOm!V+AOj~i1@ z`+;S*dSCQZy+vikwp&DBUO^MLwCo7;18})+xna3F1}`o44j8W9fd^q}6D@li;3>8C z)viwi@GQD{jAv>X8Rp*o7P1_|yq!zm{^?A>`H%sDs1LXB;Xq742G3Kpa}yHgeGrHJ zPaC=3+SaiK>N#`g+RA%d?HQ#I+NKFm5I6=h#gWOw1`bQk+u_G4T&Yi zZN$NFCJMx+K7kuk-Z$FqO29)*h^sZT4{zm8M;}YRgFfYg=|yTq@U5naf;X}j+@<1l zicDHyNd3xH(cp3%I4SXOytp2#9C=^&PTv4oVi>rVi4VNFznEmV496q4k^zi~RKQ^#$ zC#}J`F-A>utDDexq)s=DsRWt~Ox3DtvvGwwN1lSK0%=dhlPhTFgP<0fSdDx&kbEHT zI;W8izcf|r#kPtuZPU(rr=k${r7hE@uLNM64qord$i#jg67Nsz=^z#{)O7535a=`? z{Nv}FggU%)`Pce}M}U#|^_55!g!^QHj@SulG_cq-Hc zUD-qlN2DG+bg*dqDrWz<{pPlPHXLFg-p8U)0sK2OMGFFnI7%zqV>_;o9L7@~wU!0& zu#QDt#x)J%e-xiA;c-T%De^+sgDS{-uU`4b{zAwN&7GI~kPXz6o+1sx*2rgQ7uW^) zI42sz!bO)2xxc5{x8J0KKs{wKomDnoW%{`ImM;hAdfxOO?@EK2ty5#EzVUGExVz!6 z#cbrS9vW?UXaIRMf^IZ4t}t19a7B5`4_%K5HynI@0ps_TzOy&`qe@xm=JLQG z(^d$z3#==i&twCM>rQlFf+OULK1pXjl7}S^S9QO(M&s<6!vaDNGaw*QDd+kr3)uQ_ z^nN;N+V1tGqi;2hM#+_J>2l*ZFuuyK%J)YaW813UQrr#4fAO2-0)8RzuCMi(%$PSQ z-h5phFqD9f3({rVMwVE{r}~PwDG^-Kqpmv??zV%lq+#aycpPg)l=~Lzp+RB{g_ncJ3;p8XBhnT}~LaJSEGQb{x*B4$cyY3Ig4K!Y5;0HDR6=N4F zY;Y*y+!Cj<4x01j25j9`#4j?6*0@I=QYi$t$a~!&;i$2MDw7VLxLC>hNyQugd0zgo zJfe!!9;Z#%8XUn2#=OlBm;-SHTD%V5ksHi;D|=eQ3DrohEy@0H!1N!g`>4j$pk|o! zc*2wmygoVA#Km(K?^&Jt^^MpW$Aa^_hd2!IT9^0!U<*B<1n$KZCS6Q1>YI6Sn++dM zN8PbJt`Gm{89tNq$>Zhd-k)pi*0}%M=9Y^g4}^a_X>8hl7JZxhhou+Ppf$y@otM%c z%sW^YxQlIZj)+N6xxpEg$R6`=346fBq`YtKogVORCG9ASrW>ZkJ;?_%d(@}!G~8xz z06M3v?!R98z$iby{VSCVXNiiAJE|)}s${aEF@q6K2VOn(Le>IlUR6=a>DfWY*nmIP z2Yc8r_0}M4%m!u8_phD}a76p%$8*;cG~im?_I%&GJxI}dC4~N?!H+HPo-nJLW8XT< zl7X~5#+jb_rrF2?a;gUzQ@&`xgyk(U|H~)w`LpBsU)GJV!c6_yV@-LS^gBxBFK-Mk zFL>JRNd)1M0hPDbb$w(V+b>UlTNnSDRs;(fDnRAi_$6st9q@3!{KHfKw_I0bK=PL{ zVWd7_w0SCA8XcWQvop6&!45Yk?cIOcuuNU{^g0U{%oRR#ns}{)ac|Giln)DF_L3#v z2(vO&eAr9WkSz<{nFpBvs`6lOVoRlv$Ucl$eI*>s%z?tkR(reHcu{=(nw4sq49Fie z9J&!H3)!`2moySJ@Y+x9Bi9U+@M}BITF_N3=y?(%Lh7Uj$8~Dx--_$tr_JCPA7=wh z`|Ei+8dTw{!xfeH{`%lczc#8oC5mcPjaC=J4YBud8%4#-18Aoza*&@#9T!aO&P`;Fi9ikQ}FSaV3!B&-Vl4q=|-J4_9^nr>Z7=De`ee%))6#lm$ z&M%@3DlIL0=|Y&`#?#Br`Ynd|$@p`}$X8~xGb(dod|?P>`BZ_{eDyi*?rplxCWV_WA%*wpMG`tVaHtl^_(*H3S?&lBpG9j z&s7x#Z+(#WUrL+XHiy3y^ulaU4R9ut)SB;;IZ`;ye#zC<0oe$rcE_V8aK?Hy4bA1z z;q$bLf{hl6*-{Lq>FkHGX^D`BY(lV?=l8}nP?gEX%kk6I9z1ZdH!#uU{0Jx$|5|2I^fs93(IH{(1?5yqvW+$sU1E z=Pbq5u$TC5Fh!~P_C1_?v)Yt=ZyciMYR1WmS|H#UW16IA54P#OKbD==gHPUt9Zlr! z2Aek@KG6RtM2CN$pB{Nufq&G$#vQ3jgVSjV{633~c$kA+RE^0CwRrbVIX8Dh9c^b> z(ntYr(!|*BnNJ6y)+?2B@7rMl`UXVUYGEk(EkzSm8?Ne}Ikm{02n|zlck=%e7wqPEpY0mLpS>n~pQ@m7jYgT>**drw6@GUBPINF!R;NuumBou&3(IWYGyHSor%Vg^Q;Y z10$BFO$RUImf(5i6XIcbH~3Ld8*@IG{|Ir+eH@Fu&vKKJ^#gD=*f#I^Zr&%5disrd z+7%dgYW#U*(hI7NJ?`RMQU-F3@B60~u3+z1fLzmfvI zzcatz`WA#Sk4R-{Z+b(zXs9!1XCNq&%rFLcIYLf}R_N!tSnyB5uk!)f;O-bESnQsM zcgqUwE~$niRZ!DC&KKE`QRB3oR>lo#Np)F)_j5mg6 z$H5cD!4vhGiI~;TGa6}`=lIWERx+pN)%i-Y2;RR<{`bdY(RAF+DFzv0lMBK9A(S8^2kK|tu z(A3R@qwAMTai)&GD0=<;w9{dCl-gQ7A5|X#x2Grbx-FxyQSJnZ%$5i8xID-?D4qm1 z18q0$qO4JhkNsRB<5_t0(8}Rzoj-_0o_?$y6N2=CPNOyZY#_Wnw{mOb0u0q{7_^^s zL#w^XiCz7PXghI6xl5F9h5GjPjX*f>&3mTv zP$oRM{5OfMYg>+U=8gEn%`lwSY>4gh@dNfdKej}>wc&UZXGSGQB<``%)XB7VfnV#= zO!p4NKrJzy`u*K`oN4OEPz^2@d?=Vw^zy)2crJ2ICZ+TwZkH$I6?Ry`z)|A;R-x8N zlH1(Qc{6Z#d^f5cXmf;Xj*c$V?(x7}W=fv5`y9773Q{fKj>RNFxvzdNE%4gJG2tgi zLt)`Y6|au*3FM)>L{xmh6ocD{UsS)<#wG3Vo(js=*vL7UB*j(!R-f&4$O@%SVZjXz&IiXtAWD}(y;+ha_%1Tv>4%{8L?d610NhZ z<8mreMGx$}JacE(o#2F$j9TcZA{G_!RI^iBqj|yA$b1F`IGtb1W2Gn#5uPu+#vsAFeA@GxJ+k-4dTZG8 zz?fG=T6?_%wBCNfsI+Q^zu20DJHI<%AQfwW13BkmXy14h zzCGd#)dznB1{7(+H}`|>Pffk>7nAhaol*^CmctBtVh?ElvH4D3j}vr%wV3_ta>cVj zuSm}oGlTDok4`OHF7U3_CMl9c0T0-eoBR>7$H&f0?4D{Ii0lBU8M2lCPS& zM-tbY<4*sMG6S}jLunrlD1rI9!9ZlQF`kODB3-vp#x1Ur7{)vL@MrN^bDoPKkcm}K z3xAYHiciP)^%fdoC54p0_&;j+?GTdoO~eE~CI`gx#3;biRe2#1b2D_2(h;~Np^sz= zD<_-eOd)zA%Bo%43?_ztRlm11K~MG4I{ypin40rcdC5}?C}q~JJY%x}m6}QE^hp_f zd$x|M%Gnr&s6Wpd9pZqI!X16tP#sv_9(0yG&jajycudS)35{}t?$|Q}(h@(Md3%!= zj6~zOH|ABqdeL9A&5i-N4(L3j*sp|lT$4P#`0jj9A%#U1D!PeS+{vZAU z=x)fk$@{B-%|CC&gy;ik^l8u|erF2IzK4USKnnujF~_ZP8Gs8DikJ(*T#_ z7wUZNN~QsPWnV;e(D6pRbM!U`rZl{;}&Vq4G zr?q;@bj+c9vC{W62JD*p3%wp)hPR~$IvTSR;H{BDh-rE&8h`8;40>RN+e`10x~lhDB={jLSBf*S)O|?oU8)Be@~AXo{YvFK1R%ccM-YU&-{4%)gM28 zh}icxHV<4qTH}V)3*pu3fZOTcA=tyhshWK*5#+Rs9(acOLv@4ipNbAon9hGg{;qy^ z-pb%_IZT`npXd*7mgibR&i)hIQx}skdBRhu-mM<`QL$~&-gRb@%g37 zr5MQzz&1g8^5X4O5Ta2Qd$bmh0*Ca-vo&1s(fb6X~^(P%ldRw z1SaoO9^iYK3}pKs(SITf0{Um2`b+_?IQslme>HgmsGT=?;d9OtKbcK@*0v18+pWqo zi*lKex+Tc^n0%}2m$morT+MJy5@ z^;yVR^G9{|lT>#R;E>2{_U zbcMyf+nW%LPNz2(y;Nh7SxS57T{9z;{!(yNl1czh>H!_9K}#5#y`uSmCJDJkdWBxS zCW8+N6*XUDV&Rk({qQiS2!u9Qq>^3_LZt_boH-|qVJw8FuzN%V<*B+mxw!n1M^d^n zYSINrx!qh&D2Kq_Uz1c1-t%EW=O4+TP9HqirT;Co!xYG=Q{_&fHW;ia-{WmJ09$99 zq076^y_fMtRELt?@Qqm8O(GS*gB4>hHvCP1ZvO4J!N=NogT;l(^o$}*3SEynoM4ET z+#ZU3dF7468#k0l(xlEld%;N?ORWItcbeZW zJ8A@Z*C%9CEPRm8&89$He_1Z4tXEW%!~vY^#9QZsH88m(Yx{H2Nw8`;pIjJh0?ajk z4(X>#Blo8_GFFxxAoGc2yNX>4f=U!CCI0GTkb6Kp%i&X?_uKm+iGUj{vGKW!zS2jN z6@e=(Ie{3lntX-(*zR!+&+b#43G+8o$FXs=Z!40x_Hp&Xq5{IfWM+71UD?jMusVuSEBN|(wH4xqNV zk7m+RXg5zgXjM;Vhf2BecRCNqLt^&#n3NU^;8(NVKqVpk#BjPKy-)+wUE`0B@zKD! zv5yxo#ESrt_@9Q4rt~sZSy(-I{bIcA$j~)79%%Frk0+O{f zBi8Uy=-U92D8pmfXT3~UOi_i}mO1CL3Le7MSC)c`u>WOPQ1!YhWYS@8-9cU`l>2N| z#j1)myKi^=3d)!xe<($1NDd|n{N8<=rIYT)9RVnDeM6sA!wt1zhGyI1aya7sf~h!I4s#9|wy{^M0b^m5M46`s zq_?L2o(wR=s>6j}1@9YRk8l;S=&~s|x0ZN~@SA{4{kPMNDds3>-TKC7#soWg@9R>o znZSimp}$WG4S{v#m=}MYCYtfzFN~Yl!p6=Yu6LIiAtl#FzBg71`sMH5oc2+ILyq5t z{gU3xnX8}fc1bosX)EdnlAlD;G*tG)w;28p>ydHZF-aXu zv}Jfc(`o`)OG;wpm@1@q|CvkUk-%>M!^3#s8JLJ%5d8eJ4V&wYB4tkAMw4Rkr1JO& zz;@zc5) zk4)rLaXX~?8f&emT}R!&qjCXNIY4P(Uf`H`9Y<&Qs{Rbz1)u$eOvOw0VC-U{;yI&w z_`Q7m46$1+?(5^rQzUx;a@>s+>4MexZ%@(kZKW2JY%E}(*@}mN%zInQn>WElA-ezi zbTG($(oP)Z>HvXBe%jq3g>)pE?_%oe(L3~$XWq#yWNA9=b#(OxL`yu{7d(Fhv{Zke z|FBYyhiLd(qZS)5NcSO!?}t{HS6McEP+tLqoSg~lG}kbdb6B`xI}hc)IYm~tB|*F# z!(HCI>$~e;9c_a5F2bEZZkb25YT!@aO^J2xO57yR8ghv$!Hshdq%WmqfW%_aa8p}7 z6uY(>v5}+!Mhs;tTg7LW+{QGf>QBpZp z?%aqwB5@hof6M=*Zgoc9u+e_XvdgIR{i>#;k}|NKUKwttV8<8LS*mQh`n&5Cw2A&9 z$siv$F@FDJJbW3ZeG|`Lf@NQqH~c=k!>uf=`e{`FJM*%OJ^AV2_q*iL=k`P-(;*|; z^CcY1X{If|?>=WswARa1Zf3#Q-Y9?9TMl?)CEw^Z^BG*RZ$2ujU<9?y_6#npr%*Cn z+BBst6P&kF_STcSL#yw#T&uw%>{nd;MK#2ZaX0e(Edo+tmF`pWG<^hqk>4Fvv^mHt z>ZP&oZ5llH_-(kk919g&_d6{4a`AZcg=B5u8cpPX@b`ryw7ng|NcqW16g`Lp9S3)6>s%o4} zE){1U34aWFt%=uWPn=bckA>I4DNFs9j(C?kv+Dt^2^=&PitpLlU56`h9v`ZRg`x`S zcrUJt=vTGMT4n8w&#R~O=H)LzZ=u0I!Dr#1`{i=1%$o!p1m3KlB2gW06HX$H> z@ZD-fND_=u*ZwkyjKFZFdxK@Esi;MNpzPewNEn>Vah;vZfSL4Henhd+2m;m@_U30{ zQ7jV~3^N1!%wm?xwNzLSHo73f;05f7Jogq!lkv8?S-2*@BYIMr)O9@ygoo4mKVL;T zLgIk%K8-()*ubk#uc_sYr^F&eEf3=C|}5KqatRNF>u6MmtS}dpAv?&#W)t zwShmnPE(-0_H+^;NBABGa@@_Y6#2co8vnL|>2AUIQ! zR6XGc1jdOWDFZWC45aI4)UWbF!GZws*i>VfdHHa~G}RH*EB;1BMyf!>#^IGyFDy}0 z%tXv!!vg2z=cdz=9N@dpk*jI$c5oxMqYIrp@z9W3)OfuYOizFW=!*7tw=-nowKW3>*0R?QRKej04_kG2WT?l7g2%?SFCmdjJ>fV#?$9 zPMA02SX~3UZ+nBM0%sbszd`&?MClWZBs6s3EkV+dTO^G>G|L8 z$BQa>eBnL^v6rY`?NuJcJrcXs2OrKJkQ=dt^w7@_1oSAn!#av z-elWURn&{8OwvAWfwyO!?pgd41;*b?3LQg6AW$~G5=9M=dh5#fl~fhvhz*rD2V;Dh zPdWFelL)`W&=9$o7=r!EtB?<+=CE;(ugLPd0gk*oy6hTy4qIgE3m!CU!M=#SEIxAQ zVCDpO#{0WUSp9UR?BS3JQms*}D^QUl?;ioJFQf*L8uRyF&yYO)_Dme3Jfws@3{~5X z7Y*_HY0BoJS7#x2i|=Vvs|k>j%=@1|avGUVe{r|AuokAYUEUMZ$Bd7Mh&YuPrQr0VMSC$83GAoLQs%sP64E`V*ry&T zfdDjd_}M66VEXfXVL5e-^m*~6yGIH3D04`~-I0S=mJ~Y?UuDpzd+x#F8&147e&prm zfB+=eL>rThp29zgoz&@t?BEjrfTW~Q1pKaO@T{6DAi09LSjkO6B#sV#Z%U;KmbZQ2 z$X)@U?K%EseO&`T*-{z&$!4S4P3*x9JZIiWbrhvWT?TJV9HGp!m zr*dBIEPVJg>e||{TOV=yX^BwYg4~VUSBjji3}GnAYoAftF?6#Ujc2=Nu$!mM@m#r1 z3k?U3()@B$2RYL|dJ__E;4||66+qY#`+0~MGYc8U=WLq3xz9fA;Z>|E31w)&a z^4c(7lf+@)tA-O!p6q9H4e_8lci#RbMOa*2QkrTqgnu6nZ2k%m#&f05)*jfZVE|Ey z*ODU}c2^zFaB~rZE01iWH@~YuMNQw6@o;A7f3*FfVax#KikZBszRF@z(0(RbRs)!L zQ_`fEpa`qiSx!XlsAJaiKc{&;+fa2Upa1ByJYcq6wn=+f0arr3+w@zXLTjYhHOjSC zNS_;A2o#${%G@p0gL5^oBO>;);`c+8SfP8GD2q^dCXDWGK@j+!bU(!N>Jb<`FV)zw z?}bSwe{)IZ8>kUTlRF#Qji=#m7VoH=0YDfb0jw?b-A!U^_y?8pwME+wLdz z@I1!`+u@kyaCoBbq`WV?}Os! z=u5hV^;rAtw%rD{qC@%7v>S^ha3aIGR5!Q+WRytt_xfj`$$|I*1K$*k>m>82Q|-Wf zYNyr6Z&{c;xlOxPa~FofZci!SuE$^B`Mknc?x4l9G`|e59NZ+Dy%gar0?#+ZKXnGS zz_TYRzwRkiLao8~tV2WX$dRn>dx5eD?+{7$SW_gxGD+t%OSdE#Z5nz;Wm*g$qT=hq zLbK3ZqDMZb?J7QR|1}6XeI`z+z5s=nI{L^dgRn=p-1PW*K17~9Z!as5hmXw8FkFky!t=QmuGaLs z^-{g%eAx$sfsOp=eM_GdYzrk04?ALE3mv&w zdIp}#F0`$!F$9OG;I_Wy-TYAJzjo@-NEpzkC;x1ni(kjWbeVVO1=j@Dj=ZUf1JSLC zxvSF`pk@A_HZ7|iM*8*mads!7cyTjH%^7zX9DSz!X~Z8Q)eib<8FRzl%z}!gudZnK zvpaLJ(HorRJp`L4T(DYtEzbTLArP;I9Cs)KjaRp4Li53KPj35A;BlDP-dK#sJVs*{-^Wqtb6Eykydxkfds*9_JPi6gUsvpWvqL^l zqem|+LUHd!;)wY%XVh%#&d`{SgcA|Pu0ydN;5&1-sA@bIwcha^EHe+s`l}v9iP!xg zcrBGBWPb?UmbTLm{OXIh>L?6f+63Sk-v|7gx-M|@{BMaAX;-k*E0h=%P{XcIa10aijW^nG z%kAil)_!9!jk(0%HEe>lJ_^nO$cr}|KB_a?8-Se5FRjA`#;B$eFW*b8iCSkZ9BxKB z0^{A;NEQY?xI(EJFnGWlt15Ob^{Sa*!|h+h2Bz*XKCe-;W@-#UCv*zqbyx!%?EiMRN4L+eB*{57~R-7 z?(xcU8sR6n`VnvP^=B`y51eI`7!PYtS+ zt;VZDG{CWj^M&EQ-8}x@h6a{5LKsR?GdwM73DwwV>#-$@6UQE3FV?d{ni2n(kE`Y2 z+1THo#~ztNrK%vq^0pp|O+Wc1!)Jg-r|zC46V(R}t}zd+k=10)Japr75dV;HU0MkDh2_)FU&a7fwA3 zDw-Yl-0qu0n4;#}>qmr9Ku>e+J-Y>}8kRBN$P$9wo6B?k2?o&g?A@OAO$p>+U9Vu~ zQ^bI=;jKevGB9Jaky9DOg#xb>_1QfX@b{A*k1cm)Fdwrs?^RR+`{N29zl>@iD=UNI zM1d+Q^u#xRh~BL)4`qjqR1N5Aov9^TIEjVHU+;APRL3{Z-<6!bEQHgtjZ+~^3P94T z%&6I=22mxUFh4Oy{&uI5mv``Y*EMS$_Sz3rkh4R&tXcfK9@wwG({DjpdK;Omr+*p`53`$}OyhxQ99qjfit#j_Q@%Go@+_Nmog0KX45- zV$Mwo7}j9?x93@!Nw>gy-~}0f!euCwIjizTp$4-5G?INkQjZHS#9O}3sa6tdOGZ1<_v0C%d}TN}=HY_F};V*XgOTZh}Bu$_DzT8iciCSG_VtNgO* zZ=xE^eEN|k_GK8hTQ#m)-K&PJp1)IzuS)SG#})=ySP=lkN^j(1&P!SrlZxB z504&Awxh)pDe*a8?Y<<^-b&>?k+t*mIqfv;(f1em$)wD$6<137VQvT3NED)_gR){fz z32il)3YBzEZry&Cju)i6Q>ab`p>;%|AZcSbEIyo?ynZPVe1uJLhT2=38Bp9vbbI4-1T>J1OO3bsW8UNU7MZ)>rE$-fHj}F)LRf{L&Ag){zK!`= zAnO~4#(z{zHa-Y~^qcL3e)e*L>yFX2M?g`1ttMAFE2h8M*=L;-g%pef*4~F9k&E9#AA$#x@8B620@C6I|wQJ?g zvAgvhxjj#|93bWak+$!fc&HISrq`(uiB7ef49`KpLtYO{{JQFC0I+*l9T< zJ&pN|;QTZLt!U${?NFB1q2 zLKe@8iQQ1_1uyC2N-KpKD7hcN+{SK#q$h0nl|)q0w&%hf4UcYsYOM^=gXiYsUY1Ax%t~aFN%OO@QI=tWU9*YCE-rh%LPb3ZwjbG-jsk^|$ zNHT+=pdvo982l#v#|0(!vA$&0(g1b`T7eHooS>?4R50y=7K(JtADgeUM(;bEb*{7W z;3UqbNgSfTTPM?fkx2F!9vj(1-%urlwRXj?^JtWCPm=q09vW^8>ky?p7-0y0ioc13 z&MQG=+3e@S5es~Cx9(8uur^kapRTe#Yy*$i)S0VRG=V=?Ez;-4IlM{nb|=794g34s zct}o~!Q`3NA@LzOI8gZEn)jGGGKaoysORFq6n6Pq-xq9fI*Tgj*Um}&aZdY^6uS(R zMi|s~9|9oR6C=eXp@9-*w}ZZ|Dk4|t`UU!G4cI_$(PLq9@R0t+kny+@N*Fcwe43x^ zz9Uq>HnzbHZD&`EnS*7K+}^lPn41ztRcTHgJE#pG`Wct9l=i^9W5>59BSXx1yluK% zA%@>ozPPam8$nZ9J0I(D9iY{?@KR_uKT4Ystg0Drj(@8yN*#CSgHMmH-LrgY2jf=l zC#$PZv9%<26o($nw^p_2Ca#DI;#0BC<){h z97`#IX(Hj|@ZG^eF;sIR;!!IedH(tvDT^QeaIMp%AFKc!R?y>7E&FL((62-vClarsII^ z@9b^@IT5;rm5)2_t3p9q)o~KDbktq7xSGdU1y_NJWQ;Zfql-SL-SJC6x#52YG=d=;4p(>U$2sjObjpB6M9qAl zqZ%zv9=n(Fp$T)c7)w%4x517&D+j%26@*5JmT5ey#o~7MTV0=GVYEfRb6l5JsHa5iq5D3v?-yTJ!iQ=as z4S@&dUP81jb`(4(`YLz{>j$)5jUSvxovhCxtg*X!ta&=Km!BPh-HJlOa;XsSH;8>D znU9C=3JDLk>1>F8sru_LMI@Rmv)F1y6ykh`=*fKvMPO}_FDmmS5w6?!o?hWez;fo~ zq7b%Je0C#;vEy?R1ZJ7Dk%1ER3IjESH}*6RaCyxWQ5{x zP6;8qGza9OIQ>|JDHb-qC|)M6_J_1dPwsgqN4&Z3f=;$a6exLH3cXi~fH9+Tg?7q7 z*m-YG8JQx33l%gj3(=9F?N2JW((I3d;g3S3LN1^rC9g-4lr6Zu+^~ML<_5EZgMCNK z!*I*){Z5mm9X8)ko7f~yg|;e%-%qs@aQZiCn$N{}tgyCRPJ0#z1{rnM?8`;)@QuRR zlq0G5?y<5H@opZ)s(p;v=x`kD9hv#5_-?mOY?LB|+b9wHJQ}4eAE!bOox>>)y;OL? z(KcnJnuzzvL3N*N3ib^hYM3!GLke*ZQG3NGa8GDX=U?>3&^;2$YL0fOOm@`g_3n31 z#=pE2XTQebl@0H1_SbG;eXA?*Gy z!Et$Mlb;kuIC<$|Z26a9#IyhC>z^7U)vY!jl~=oU>(eWryIZWl(&WbPRcmh?dt#UJ z{;4|fbQZWg_1;|%RDb0jFyxIX@h=y$IL^Q)qGJV~?4b}XQ+;Qy#{wl=4Q*Mc1JEM` z`|oZzfLN_+?-_nixXxl{Z%^rton-r6DY@kE;1k;aL(zHoWBImWyk#azh@?nHkuBRP zd+)65z4w;A_s%FgTZs^blMoUb8Y2BFrLq%A!+XE~!Sne%_kG>xbsWd{IN!hds}8jX zspkiB+>!lbTyU(V4oLk-@+NBu0o|>EYrEirHv4p?_WJ}QYbWD4QHxcB$-lU6Mo zDCKH40k{cVCkJ+b@sPd&TJ}YHZ<^k$vAt zi7uv5Pj{SJv&NlQKR++(Tf=Na#XA>*U;4^KmJ=0fjj@Rz|K>i^fT6$(@^+?XV0fc~ zGb+L!2Q|2lRuTEt;O-OUW#`=CVf{pas`{h~VK`KlrMz-!ej$`|{b@Clqny>ucSY zr{#bnzK)THfj2Ve4lnA$(CZYxr}1hyB}!!{azGPj%lh5@e<* zpeV6@<9W;!b!p>_6W*MF-0el?{YP!UdHw0zWl|p8j&Rub@B`uhUfk2cEDP{3QBXs$ z#SYk=5*FCM%i*=ty*lpHTs)va%%yo1`p>Tnsso#O zJoT`iCK$3PpWr>CJx-=`{?fc<>KeWri zQhwAQi!6DFkoffS3aGz~D3Dk+$_;&W=scvs-J((R&9D=gZax7Pg?T z-~MRh3w0==?C`{4UkPYB81b-ZW}!zpyRO2Wd(cnuU0HxS12YbFood<%!Pm~J?!!di z&49{NJ|d5UGCFA~8)VI38bF>CFH(<>H)%!Mh`bN0%G&k@X&w9&vE{DRt^mPzG>f#^@QrchPh0A}4nf6y_?$1`xiCvvzV>KkqgC(MUoQ zqekdM2Z9^~E?-A&X2wm+hgHzcLl@k7!WVs9?w<935sQOos`~?Dvp_M4Z}ctyH5`rI z=3MG)Kw7yf<*~n4f$Yp_(F50V(0lFpUS6I^5Hoj|OOhLBCuX)PXFjpf-K*5Ynx0%z`m4eBPJjRD2F7g7O9J%dn)5Dg_$@%TY-CYxTf2zYL_|=(VNf_rT?0RyEo96d3+a$}z_o4NZmqneUX-@cUC& zEd|y{v=rIrV7WgE|BP)#KMyFvnTKkuwR~4#?x#xc$8lR+H0d+$DXPGPKds4)Lm6;U z%4h6zNf=}#1poML7=v9p`{@fUeNcL0W$nM+X!sS%%Hn#?9++A8*u}YpVsYX#Bh>?8 zI62mF>;>Vwx>p8uN_GWxdH2?CWJbzc&bunpynav>~_?j}D>R z5q9YM-lo}=@QpkuE{;9>nhys}3k#I!qJc8y0om(I$v7t@Sl%}fje8l*OZoGCK`?DU z=?0?@E=P$sm7PyPlA}>SkLbt1#!-rY3)Ly$GViRcN93nZI_ay2IGBUZg>KUGd08Ms z$KM5a{GtEu_n=6#RD7)V{4tXx!IfRD2oWZ}U~g3x!ebuY`fT=GTciub=q zn8G1lSWZ9EMi*q?dcNz_@x$`#El-MvEMO*ulB`Bw0US6RJ(X|8;@Ha{Gi`&0xX4s; zpEougILtPlY1??Cts0FcS5FG^58b{iK6Lls)uYYM4~py z1dLkH0!ur8#B(1X_!weptzG61`7I*GXQP`*JTX^J``5$)A8=Ofww`?C3OQk|1&k_xwmtI@YLd^j`zMqM_Kx2n|^q=yS zI)WfsWYM9H!4XDfDDU&-MW72Qo$$E?U3A}+j+MAc@CRHW{^D~Y*pqvq%QYvE;Mh-P z)<@}qVr^xT;vNe)d9$?3(b5nvNAEn+p1(xseYc&>#0d^P%1t4s)&ps@B?1Iq>tbAJ z&tBEH{*c(Iv#4;<1bcG!#0K~JVAbVtlj&+#xZaZbPVu1&Trj&ad5Fpz2h1}qJbxNv zPj|%nLb(UTv8r6Nel3GyY%7c=Lx#96__%uXjy}|QQyY;}s^Jz-{I{Dq4tQqCon)oU z5&k*y+>ifm2ix9po?-3INT1;1oZ)PTw-!HsauRohf*WK7#p8w$`H&;0R>c}?T#~Z` z7No(-W96Od9!(hZzIOEJJ{$baM#6dH{b`U*IjH|b*A>di%3R|r^ih1DKMU=o8`4TD z-!4FOKl3@NWR}VcaIqZ?UYF5zZ&3y zp6R>d333o%{5f?eS_KBw_*aYxo#M#RGhubg%&@<@@p*T-E)+DAhdkC$#Z%L{)H(ar zQIBNZY!LL}$TgLS-D+7F;gdexdT9tVIp+Dx_3ZmY3C26LDWjP(ZA-%KX z9VLOn95Mp316o9G?Ns45D;H=vE1GuRl*Qrl(eAu0HrRR6eR$z3Gupn}QivIm#>6Yy zl!<}LFy-0KwHBZT>0>;JoT+*Q2g2&yYp8?I>MXSACiS7SU%a7>SrgXS)HWRAl#qt( zvs|%>BFf5W&=;+7VmW6IrT(-aTw5(R3OCk;mE}T({dW$5PFaiBH)C`B9+lL3RFNN5 zSf9K}t*{0&72o0Ci6XFZGWJ2zd29Shl_N2mdKRTR#5pX4FM-MM^|{KeyI4NSacp(9 z4NI-WQ%{d3+_)ox>!0|@>Pix}}uHVH8&7I-b zzvAGJg5g5u_h$4;kCkPjZ-w@o!Hah)`tWB;p~A3E6MW)LZ9hp-o8NK`6t}-Ji-?C=bbulaWM=^$=689=klOg!%uauqCLt~|8idWT852M&#$iy zhl9+~^o$pDJ}_e_2z~wr=&QD$cjtr?Oc{NhE)@vFN_p4h{=JpJ&6J}jw{`{YNu8!} zxs?H$7EU$S2t6TXFsDQKM7LjpV~xu9JVBw;4$H z3ZJ4kApDRp1M*LuA^4`WN_|^44)%@?`sB2g0oC(^zaq19FhFQ`y4lqR-hUYLnjVjU zeE#vUJkG0-PBYNNz)*?HN5+4IQraNxBf1P-;{uR+wE3({Bmk2CrEo`|$wqO@wMq)6 zJg9SEut<-*3MTesG^G+(F=^dwcJN#}#%wI*+wc>-B~ye}OhXL(w-oW?!d_QcAi1Gh z=NXTK$2BC6@%m!GCv%SJHwpM!;w_)Md;m23{y=m0Vj}jQwBs(^2*4iRzoP|xv2et> z-?#rrA`D$OX>N7%##MbT(=%D_D4x%;`ng3J*EZ{sGx!R62W+)%26{l!x5?;6EnSRl zn{!N-bOMawEz7Zx$C-V{)I)EQW9l#Vo6#xxxW_8&)yKPm;Pc7rp_P0(JX_}}*?#DU zKOL_R6)|U_ufO9FDI;abe*K)f>>L|j-l<&D-S$Ne)3+-3ZpOe5DsJztU>n$79qh@o z2*(_Mm|d(6z_^0{z63aBfe`&d>wd8~a8^F*kTjNxN=y!6w?d5I+7m(2Ya97+b1n1l z8&5kVyTits?U{oMNjqhnZ_U9$m*aQ+)f_O7Otf1*8i?NtbM(1AGtg{h{F z9Eouj0NoOjCc~~6{6tz3a#$@C0`;i!*Sq{-gFK$Lm*Ay9#`pzxdSf0Rm$Swmcjzw7 zahO>kd^`oaCO(39zQc1~LBl^5@nF#3f$cDCwbOlH*ANB&xZPBzk|QBrPTgf9KM{9V z?Iqvw$D-~$yHebTD{!#h18k!DA98+~`BWPfR?GKok2}C|t;{Wt z9VVFdy?pxB2V0!gies;vvxYPeqoza^Z}|G@ZgG*HBmSek!ai#1gOhb}Q7L7vz>&Ez zFg@oA)0!0LrBht-{q=M51_l<$VV^J}uS{_59r=$7Ezdxb6paPnmIdCcPyBn+!~k}# zotr(xqXK<>NyepxwpgWguD>?&JZ8reZEJcK(7r6FOL^&&Y`xt19h*!=^yqm0IyFKF z1fC9XaT%GQ%@2lhO=?*TSBX5{f6x;wY5r+sTPVVR|P$&=LX|u#_DQzIZ*q0+wKbgOUr@g`uYqnapSM$AwnB#&lY18qnZc9U zl+Tx+UIM+k_LVGSTVy~@+v*lYyn4lryp+`%-u`#`ZSHkZq~eO!Gx>BGE9X9|$q5<4 zkE9+gJfsij9IO{TX9$1v=_#2geu5jkz|ecK+#0$@?zIf8$>Um&%Hz1}miX*};Ux!J zLy)QIt8rM-gSY!qr_P2OW09>%HQxik)#M1niV#EiAXr0kVTlzhpTxd2n!Ski55{kQ zGm-?)zT`?F6CRBC(E3B-sw9TWP;@lz=)w8}R&EC$Hh|+S9lz8}G3WA4g{;erFkNNI z@Xf;%M*ci)vf&fKA}30F;WG?9x&*Da@QoebdGO9__Bx(&x0ZZp}V>l1tOQ$l?WUi>-m*Q!zS$m?Nt9Z3%+f^0f z#7&1{o+yJxTCyG!F~=AVi*rnhE%xR(CGSxjI|AqW-dKDIRK(zf$gT?`62Q>o8vmuj z5dKE;%o!x8V}FCDa8k1|wj8PUs%_T-#_LJckH`(-+QvxmsRRuqk!`}zes>S@L zq!qzmjBHh4@f=p`N_%R#a^um5-QP~A8-Ukzr2dy<{3yI7vPmm#jbpl8rq07Muw4|C zGUrV6qAWcS+LzT24qb0et3FkMzL)Vdr`K&fd4Or9-=zwTd~A6Ro+UV|?AGN(#vw=` zC)&N<-h;RFU!=``h6@YDiMc3Ep?E8EMlTocguOpj7ivAxGkE^fCHb;UiD@ zN3>R^`L^wF{;o2^bNNoZqVRYEc>3~(H_HhFxe>)_ogz4* zlXk41t^}84Fvg&1R zB47LG5Z{}3t9Edr_efS*UjV)>DPw+Lng#Fc*tdRv%)r0wx8EcjxB*tqXVua-gJ7~G zZqz)p7@tHOoKP4y$9tz`*;Q16;Vtu`p&a2K$Q?cW>sxUF^4qHjEr+Gy=}+!H%N98x zQ$NA3zmW;#a&^ZPtbCByV)uC|PZ4gm*Xz8fcSDkFhdnF4A&~Hub6J%3Ds=3vPx{Fb zgBj_f=NE?3QR^uAhJ$Y`ynNzGS>W!EeIwsIEeIV%*lc3Th%5xE-oM>ZYVn1|p{M7( zcY}fL$M}UdsYGm{ZPy&R7LP5579SVw*M}$ff2ofcg~O#r<7s2zD0FAK_S$AG7Ta0u z86xH#!FXnYVc$|T+zOT5$~kEb6RLN3teTyW^=kP)=g|P%+jNGTf6*B~XvqCBBRHcA zqi^HtglwR)UAt_Lwm;->Y+O*2bU-^=PwMJ@f_V3i#Yj&Rac>ydUw-n4AKcSpjN=S) zLphln9P(3vIMH=^u~W_t|5=^8qB0T*ZkGnX?;dc3@{2Two5aJAxA5TeSZc!GNVypH z<0J9hEOxJO)8H)Aoh7br@ zJFl>RDHv)#?7wt&Iu0+TJu~uA2t}QTwF|VT(%@on6Khrq!@Swr6LSSo|Ae)y)(J@kyAl{yd(|t6W$22 zV>6wb{zT41+fsJTede^+(wVqtEz*&E_KBDvsj{z8i(%bB(JfQ4@AMQ(GMEqrgEXUGr6$CBDwCC;3kJ zS?d*xYVWA+fZ^(8GB+(NXe~Q)-cZZ|r;e6$aZTBQN|ugPZxg{Ee|x__V%G;>QB^(m z)f5JIR~fcBBR_&~ugyO9${C;V%dP!>;f+0X;`Vl-evq1$bh(-M|H>Q~x88pa#Y^j- z-RZh?@!Bi0HbrtjXz>wjIIODxE8efY-|aY}!_Dl@P&a8@eSEKweOeR~B+ua1X<0~a zw#irjZ4EXP$|-$avN$I6LRci$8+rNOe!W8YM(?Z>X{*)!ptvN8dBw{KMcqb(f$S0vn2>XAECi68!DGN7TdS=wx}0>tDAz9$+Y-Tnw}V6Lveg&IlUF6WrtW zj`}hRpPAi`Y9+Xz~gYMLjJm_KluY)bmi@BKPGtz+xg{B&D$zLk;Cb08;$B9 zHhxh#Z~6#OREf*U35#LM8Tug+RU)VRij_~%pAPjC-bNU77(xe$@^#A3BA_66uiVGh z2-ogBIR3s?5J&!go^X>gfQMh1oBpbif-v3kr_UYYc$VYPK4nK?2rXFp;_*isWo_?P z&0i5m=RN7VL<)5h?*bL%Cu5;=-) z(9<*OYT)((^2bw$#GvX&SjqdVXE5mK&6IXeHEhuOE&B439?&&<@I_zLg*i!ziQx%z zEVQe1eteb4_a?rglA^N)R)3D_r9M57GtT})Pi=;0sb{%dgVoSDkY305Fc(?=leK-uUr(ry*Sqo+4o9T8NU;G5+1pFx|~k9kZX}r zNU4J6m*idSwE^|IeT`L|c%(w}1P6q>DM5ll*RiD7kpk&-PmD{jwm2Mb4*sgW^t9fDh&s)tYjiq=sar6G|Kk<0wY^34}Nh)ld&-##esul(2LhFX< z>)_t$Jk>1+TRe8R==J~iLJZeGO2~4*1bO77S)bnIV2}QhdG5MgF#kQ_(4>_G3}*+J zGJfadn$xP%O?f*gU@12;e_RR{+V%Tl+Wd&`>KUpNfuTTJE~y<^R*0*^rpo903Q^!p zONDgQ4df0u|B~fx5lr5h`2B9T5{xHrU#D%X!X|k~^pY2QnP zNqw=lgAD$#e7h}8Iot~l)|z@nRVG6j>1Qp6k?U|gN8w*UaWUR4ccrNPWsBCFWD@j@ zVUW}ud_J1F2woJ~m`uBQL*4u%Q>~c{*f*R}lw_5Ud`XoLNh5{fSa;^(Gk^2I=IE66f; z&Z&2j4Ib|4WRly7gOv?cR@td6?DG%QqIl_#k6zBMs4d51${sS^dXi-5Hx&5gxi1!y zkGxX+Xq$t(!-`(%)%HmC+ewjGItrf9Q`3ogm|*OmH7})IH#i=_9?8&;<0$&rkYY9D=ds77UmDa$qvP(}dgB8f@JKUMnjE+ZuwWYL>zweroCKgoqc+h4+2WYYaz?hJp9bUj<>G z^tQIRMlf7<2s6k#=mwi778~v}`eVFLpQ_d`F=Wh3_u}5P0gKo_0bQ}0xUt#I`G#8; zKJcx^W;7YYUIph4O(gQUt&$q=ysYriQ)9jcfs9OG4E=Z@tb|AMR0Pd4oP|XOLL&ji$)$%JpEIpkz(IH@n zRAU+=(dlj=qPh1Muklgz`_rM2n_!I`_YZ$;&eDP9!dBmLF%fir5b^5*gE7%-xa-H8 zZw(~&YkP0i$%E>;D5Hu)CFu;J zuy@?9`K?ie;(!YK&wGIO4p1A&Z}w-`=P{(ji z+!fb@7%l;`uf~qBGqOPQqSP2Ck}8jP91GaU9aC^H+$Z7lNF7F-qZ(F34e`Iy zoTZnS<={0#dMzcTI*}it3HQ8C=rU&nWnylz;GIEgA#I{ZDTr3gC-9*pj*cGd|9#F9 zU6M}nrZ6c%^pu9}ts|GfMJ-VB>Nf?PJbASx!}bC?Z})LBJ~#_6^1L72X^_R^^RybZ z6T;xta@~Y+Ne|9>tu~NUDB~uiIjImm?=>Z+N~&wB(D+?8IQ*tQ(f4ndEn1|AQ>_!U z{JCN{p>Cn;_MZscOB??)^Hm=IO6Y79Z1O_sRZp96V`GRc{V@Ryld!1k8pGoPdKNWt9r_xdq?Y+KZt-!sVv$JhMt1$t4#S@Cnh5=5`y zY@eQhEWvkBwZD}Uf2f9cetgjntg%D?Vbx&oAf(c z&3J*a{1M}CIrujhM|Y#X429WTJB^!~A*=8^!(e3>d}OaG(Rp5hrrG6znKpL-`b|mY zMw^i(@t7oSZ8gNu=8S#t?*$Qxl-2*1YB2ZJ!rY1cJE-nl3ZIw*2VWx3j+#n^Ye5wg2Q1SkD<&c1b)n04>^#9mI4!hI)$3y1M?dB_0d#N z=hR!d+gOcKn-O`ktO4M!y|x{9zXrlaXasi1{m@O{%4CzH3|(4|tDgH)4VwckdbQNK zC=`E?j#Dri6Ee)s3KdQOrj5tcd68PHFAgOAWRwaa-05G#A&%$$`!9%pn= zDiX=VFJtE|PL344z$8+(Htl{e|%WQbN zsmmkE=nagt1!Ym1G}wEBqkL_DB9=ydZaumZ3L*2Irp4{oAdqR(&Bf~qMtYn*lq435 z`zG_a4veOOp68x$o#srqX9FHJ4Q3cPWIk}1HW*H@#|z|(S;IPPbJA^RW74RcrSYdM zBDWDZ;`1*Qp6a*l`R$a7w%;X|wFZ;Xp+KRGvpX9kpB!nc{gVR;!}Gcl(G}$VhP?>p$ zS-N=!AP;%pvn7(ff(LH>6D=cYf*Dv`eS}z=GW`5oKUW9SLqS4 zH|^*-ts`HwU4c3%U0=nQ@L9f4X>pwJ2k~2CMxP%TAX`*4i_eNR*6#a8mD(8vkIu#f zs$GTWe^o0^kymi>ber-hRW5QL3n=;!90%(n z3NM8@(t+e-XZ`K=M3gtOZ&4;mM&E_&o;9hla8_~VOt)|dNQF){D{DodX0gKb^B{F_ zEPSs^b<77uHp1sE`JyqBSG6sA+!c!)FZ$I}rohzk51piLPN)!C#cuf`5i6hH4E~|y z3oJSR3D3kQLI-zZS6xvk@+tDaQK%}|6bo3eWlk)49EI1J zt+=93TY$@{ZdaQre|T$-<>;C9v!xrF`p~;XEg{~g~C2iDC>b5XIy#STqwRsd_A#~ zqz#kQM*|KLMF8d;;mI7c_UM1`MlQFVA7(r_t5m<}23!-qa-T-5VXXZ9_hi_^TN@X-FF7q<21j|xW)uke2Bs{hf6@eQ+`UflgQo7Pb=oS>tMh| z|2L=1z2Vkp zXoH(CENkP-UEm;d-w)$DF_5PtF+Mu&fO`cxmy0f#L2UTtio1kJO})& z8&oe7W{WBHgk;fS38p)&fA)mRgN@dK>DRP?!C}{UxtOFup55k?a6Qp~Vtd}t$@~)9 zRI#>Ls5-!YgPGO7PsAPx)%xhQ6&Ebbdp+b6uZBOZPJkA%sC$G9ee{T|)I9-xmR_<4|+BxfbbtphoiU^odv##Ob#r zZ4(!f_gi{y>T?@-3oakiNyM>RyN)vDn;nWg`_1sezyKz5)qvx#HOxdFr0OHFKz8$o z{h#g=yn97JGh-Ujqj+RGA@}gJ-o^!UntSD!G08H?eo0vy&K|!Vm%rZ-tQ(HAw}zP@ z)zN#l_ebQAlxZr3{EG>6>&agr5j}_T9D1Ng8(c$R5@ZI}MycqVEHi z6p^aiE3@moHqiVW7`ACphQ?<)^+&c%Q2^otKT67BVa6o$!RpK4CYQZ1>u?4R9DUIi zYGHtnT{l+9ws~M6+3yBL*=hKi@V!s!o)RwY7Z>HW(}Qn}PJvQMx}c9?QogJ9&Z^#z$!ihcmsUJ{Qw`#Ct$*cZ34f&K5ywIABCM>Hn7b8u3rHr#lumNr2ICj4wB1QD@R)3t zl8cyA?(#d4IqxK)``cEvZHYX5Wf0H0SacQAEV3@C4_3fuI*~7=1{rw%kV>I=Za$t4 zoPA49=rRf;r0lO#)A65<*`t-Xax7O+%>6{%A9@F4HEu|zLw+^0%jJb|Eco|HthYQ7 z9&eX)M@1(>wxcN9h5c^$AokVJ7;&z1`qLe|D{KW)FVFbPE@tDp3h7U|wj>OE^uTiu z;ZylM=Bj5+&xI4ZbCFTVAIzgG%?@aUfQVW13A(@_c*F9a0IOj-zLGyRxIw23 zyQ9qMRm;&xsk7Fl=avi~No2yW%IAU`e*Um|IR}MRD`SEhl2PAT+3wa@4(z*KAy8wQ z0vA~4T>|uSv610Q+avF2e6^T-(ITf1$avc8qq71*qwdw0Dc^jIqEJumGNpCfU-u#S#&W{I< z`}~f>zWj*S;pe?j{^ziM;3knAf&jWM@ zZk?(k{Huyh5&BhKZTR{kB#1#h2rkeKH;>B&;^EtElwIuv?``t_{#)TNuzPL3n9mgk z@m9**)b5tZb|U^qhOs-Y=k7o0cE<}E4$nt0O4)#?c>Ux#T|0QGk)j}Gdl9NwPPQs> z2ch}nNWqRRZn)&Z(*wbgz-?PVTUSDCVo3L0@E=S=MJdOxdrx~}0)tgeSU@r)9=Z8b zzu5ySVEx$3v^1o@DpgfxLG0-&De6+mC;F1q>-9wEY*0w*zRR<{F(}@_v-FhE=jKZ( z!kE;3;MTOP_a)^Zq^?rumyogro5}R|+fTj0=DzPE`)wcWkG+ec|v|64(2~5qRZlSIX2?Q+(OUbkag1 z8mR7R4SxL36uXVnEVY@!F!#$-8`d|DK)TVUIx^=7++qK$!(ZFrJA0Pzz=V_d3_2N)C7Nnuwvz# zK`?S*@VD*>N9=M|Qz7<&5&ed+a>v>mbfh=d_TBX+dKtZH&k*;kipKv|8Hz1&UM+Mn z=8iY?>U%cLn(!jK^r3lQPiKtc>l6JOXAV#Jzt)`oc?n$E&L4F1azu@tG3{|13AnMz zowD)X77lv&GUmk_Vau?~wN)iuRQpoTzvXKSfzRJ14~iS&lN$#dZVcLB#-2s42g&Ym z!m*5&LfQiC_73Mdw)vt<_hM9Bx*A&Cy0|zwE)dhcNC08J+}(#oz|pk?PbMZp3!JVu(Q7L;QMqjAuEK2-}3o15G(WL3sP4zk-< zC#@mWI77KaSP&VXxg4Z*w#TVdUpgU4LMQNhEU#f;2bU&V508;s;U?+B@`yJ?fA8pGhfOqnH2ZH!eE7 z5S3PA5NBZycYo$F$==k%?t3|5XMgG7p>uw%fA5TCh zS&cCyKUU5>;!f;Ez4+-o*N81Xb0$B)JtK&5lhv2G2rhfMZSHi4usm`ojQahYwZYzv z`)(XZ^q^DjUaPUG5zJcje=(9WKo6f1i=Qln&to%Zz#FLncPgFDOt>}hYhv?yM;jm3 z9F>b|p|=2XOW|MHPLkNs>&7Q^)dnv#Iv<@P{L%aiL;1t!ts(4tY-|s^E)FNP4h|6< z{NT_pKVza-k>xDyWMjA>o}O7rO-^LO@N-Ye$>xb3>c2abE+z^n{j_(+>$D@j@m6|0 zZf^+hq@|w;JaU1y&7v6gOcOM6Y%8slBz%eYRmJMeRUnmip`Y_MvG-s!Nj~9Z7igIF zKlnLY1V5G}u0)L7K#|msQf=E0K~E!6+*+p;wmIuImMxxA5RVY31z)#P`)-D~e{Z z0+>p_FFYVlw_XMg_b{h$aQ-S;9Yk^)DMp1N{Oyb2UikjS52eLuHRl{c+G~$*%bMQ0 zm?i*EE<=LnL?s?E;9$0BE->+>Ao;u>F|;3c>?5p(NAo{2w-;mtYFq&icd0EA3dqaK&>kRBDFl(py)iFYhss! zs^%ej97Il(>XRBH<$4jcoecau9ZBQ~Wb?+>Wn(b$C8upCi8aPIxF1TWj)TaEiDQfd z=^$h$5fN`-hosdX8?TrYgLA~ztCs!Quz8_Y%x9zszc{qmSiFb={cl#=iKUFw!5&(s{pk-66N^fqhQP<>X79`3~;`q z6p>%|!$6F;_xcb9efaj-hFBWh`2Jn5CbJxAbroLBe2GC_p%>)otCe6=psC}dmIg1S z4r{YKszM?0ercNJbX?jxGCKUH4210;@@1`rLD!ENCilz&O#9{Y{m4rn_= z=-bOy?{YI1=(&7J{vC*d)Y<%f=Y?YMV_2Hl=e`_lI?ufKOWhT~l_wWcgXG|p$3$NgyWs&MAf27(W|!cwKoLk17#UOx7w=*vuT>cgoNm6Q)bbQq^xNxXsqKMDp4&N`rWGA{ESh=ntP|2-V^492s9 zZ8tu)C!=2LQ!hcncN%!I5Qf_HKkh~NDiEDAIIa|p< z(|F^X(TOQySJO^=qezovmy^A{#B1W#Vbfkpit&hKpVmw07g}E%ywK@>?Ydre! zOU?=CxeL;E2>t8btah7axHD2c^)>BmNQI0-Stg~;bJ)9P^;K~o8xwutPZ$13 zZKvmcGKQ*&(EP6l6ca$xH_PQ;ISSKIIj|YWi!@~Dkctjq4((zSzq=N z9LbqAhT~gK2pyt!W>MZ~d@zQ-oX;Pki+8t7JnUff6n&7+Vhpk#caG8Fw?%=oH!Nvw zqM@EeUYJK$8TL(V7+R!-@G^g-nZqQ2$5m;|b?5Q^Y>PPZn>Ylg-iU7|RcyDi;V* z;4ZM3Kk_WLjS573Y*94h%>xUwxFJlFD+Nps7 zdnl7_jDK7yjSM#qr9~XF$74*1(mDQ4aQ2mK^Tq{Lpsl^SX?D&R$v;X2U31feXiLK^ zAC3Shl7IZX_Ld{w!1}OjC;iZv>wZUJI>BjG8(edG=L|kq4t!3z=ZB}a*3ZAx)kFq{ zWcu@u{9$Egw&*664(@Gj`t6hLg%;KxX3|L(@a{GFm+yK8aJjjadCZT{`L;Nz^;>j_ zo^oH7iRXIIY~xUPWX=hflPSM25P68$E&ja;7T)mj*Kr9Ra$_`AJ`wiznHOpfABKJ1 z4)BK|tIqnK3+Oy(dABL=j#0UB1+QP5;=oT7uyt?;KGut&BAeoPRGq}KMb-gt*k6%8 zv2FoDos)qM-TL6}B1)V0!5(`#D1)DBD}nVx9Y=}NL|>rN(^~O5D?IDPdhr#56^8uv zh&h_(VmwaIivyY{;qCe>2=68X=Z$A)z$)M9sI~yzT(D_#vK;%x()Eyq{qq4zOa>KgL zTW8=}n_7Uo`DGZal)Me|T9~!(XP!m`HW1 z!|TIk@aB)4NKdeZLaJ-i`cz$i@TCWNynT-WJJtk8Bjm#fSGCow}oFD zq3pFV!39QF_@&2mJo|wjWc^d-kB)K1-XQUi*5?XnB|Z4UKhFyKl;1visY3Yn)r0o> z^pZHBhmU_Yh{B2QGn|t_rEu??ZfEUZ!uKfcXgthg20Z`Gy0+ZEL%bhF{G(86DnR9jVG6@7$O^6VBXy`d1#>nXWv$nuQM}ZSkdGEc!QiU z_eNvmsCX-`MpBjBHf{zHeW5Nk>Pnz(u2h`6Qh+&+?OBBeb3iv#Q-e0C7$ocrXsl;j zpt1eDxnWZV>d3q;ydk5CGhZ6jJ?O-+c9cZof^7!QNt*>c4@yC?2^DLGv~u{vZtT2M zod8d|t8RH)C8Ge{oKIX}3^BLUD@{9E!@$`o>CZt`NXM}9M~JZs5W)#+{sW5%@(H>{H2+>0!~#JdEi>Ax&vXyptnchvd*YmS0B z-4QDz^$gT4`Z{!QBpKIiwv1xLjDgX5Y0YV;3WjrkMVv|xz)Q>5CNFws;r!Le6YA~% zqv*WDdj7jG-Yyj>loUy%gqBM4l=j|xecOBQz4sn8wWL8yi=<8(5-K4wB1t0hOA1jv zpXcwcEAqwroO9pz>&}N~tKS=JwBn%r*k=E$+hus0|7deRMHUDLziJ5nQUt3Zi)}NC z1$a_VJ=Y|#0O{MfWoViSAHj>MH|jr9VEyv`*K`llp^+|n@jz=HQbkLhn7%BJLb()G zRUO{YsZ1dn*qaSHqu;I-+U3K?rPoI&Xag{5;LfJ&seI(G9bk(-7Xe|PsV>lSWWXtn z>Ir%eA9P=K5Cl_I%=Ei4Tw6xM?5&L-uaiSihfR;H&@vP@@Tl}b(~LHd8yseAWj!g|pp zQ>t+~KHGDA;YV;hGXA}dLzmN`MRoC`k4-3y$iDb?B{m&H?`znQQ@erstlyepS^~u7 z`qezU%@3qM0*TTw{-~q>`Eq!TJJ6V%(GMizNpr8cp1ztv>HC`@#G_${FKw z5}db|j-st6@@JZvdy1LuFedlQ+9{Pd2)v)J#82>RKKdDlx$hzPbz;)5zBIW(gfyqf zFlP*qAJrb}E^tD*VscvxZD%~V>%#enVPzPwbSSiN*#-3n@`zeT2Z)vVE5BBx3*YZ1 zZ${7sVroTow`-mqvj14&lCcegdisSUZJpL|A|Tqe&nN_?PxRbA^v4wMXQl7HW#k7G zGk<93UY|nQWs)wL7vU>Rk5>#(a|P|`U~2VLO;}dp{nmIU7~?CY?@vYBK(a66t^Si? zAU7Ccv3Sc9mFd143;zqlVOsN(p92Gdb#YRfkKn7!m*vL`5;?MF&kufgmz+^X|9L}B z5#b~EkuDxT}VpqIC$LBPki}uwrk~#62`RHii8mR9KBn+HOsI9rt0X;QU>~C=E^58yEae1UA5X}4gOQaCu#N{&10P)^M$OXFSjN}-`>}E#KHpiP9QDU zbvrN*^f=!fbR3rMDEz0R<$^)qi{?3cjo`rQ)!5W8F7THQ_dX@&kE~hl{rlAH(Vx|x zK_to%j&6K(kmoQ2xAM{7+@Ebxd0)~)-w*pilV!Q#HPPc!ROQ$k7pIHo8pibArHVt( z_csbX+$M0aaLDJoyczn8vezue7-I1A*@u%qNYMWG(>L0y=ivdD@v|~95}vH1D*eT$ zLinQVe6LIz!VxJg_A`Ojm?iP==hx%Y{WEjXUu~?MU}tmO$n1y#8XFjGi9B=08=uj& z^Sdo5uK3m1j5@&Kzbzzvk{xb8Q>yhjY>vtc<^#LWS;C{QRhup#4wXzQLn{pGm^8}K zHuXs#V#5-`>Xjui$MS?WIM-+HS zN#CE|2ya&J`+iL>Lxok|z>TE_Fm8VuYOEJ%NK=XmruHXib*|tg z$GoS!ErBq6E8%mK<7MdJwh{^Fx`pEWEu3q<)v%)3M{B@v3$kf$+y8yggxp~XL9|iL z$kja&tf7Aeyj+a$M-zNXAkB#$(76J_*J{09NnAr6rgjVax>N|T)_bxRa2;l~dd4-E zFJa(A+rCpwwZz>qvHmW!V%Ow2Wf}47D05gRwl|eR4U-4WKxrpFt8VjINiV}t659PwF0-;9xMyTJrVYUk(0C3gZ4_@u>7vIiQxM6t#ovnUeGf{!-&`RbX%xEG&g_ zTye06Th2nYQQXxi8R=kqO(6}`T1unaXG1}>_tcAMS)vbdHSfHge=^8T7Ntf;N5H*h zaU2DhB!_6PW@)CFS?&wrp&zNiirVN1hj@@Au&+c!%oSD z&_J(^@wFtQqJqMGHx7a;e=nV}s=x=h%!QM}{gR+=U;pm?w^FhDXaXt`dDhaD@xa)p zQLvI4sr->Y9HEFgTCgbz-%paybxrTZTMH33Dj{)jckcajz8(djYBHe}aLPv-z2iy; z4ZZQxAceZgr6i&UTzIohm=Bd7FN~z?#$od~&uB|>9K4u%D<<;85#)BpY$$DmFjww} z((CIn=oy1=rb?oK!!t6I_KN|Ge2i8fCGPfu9F(kYgWU+I+S#&@sQ`GezTs=v;(|;Y zw4yv~_P8)ZEl9g|0h-1c6Aqc#K>tUT-+mVi@dy)}>jdpV^l`oN?6s~pdJhG%KX;Ra zE0J`aMiKtR&$mADUCa%1&b4`GyG3A6*6CBt5x!VG*L7&uzGQgHn0Ug2!XGT`eXqoe zWuv`JAJbH-J$5tv)Y1!02UXqz)+3ejIFmbgJB>aL8$U7KKm6Voq{eB+xR!iD?3dBf z{nH_M_smA;EpIb0vHm`O_gMt7r>$`8WZ0pE{?+RpUqgsJD$s_LxU-XoyiN#6Ifc&I z*Dus6`(ll|S{OOO{iv9;Wrw!`5Eie?c6WCu?z3$L zI(VS5I<=#!inialuFVOUz@~^K-OosA2uby}KV$BMMf+IjL{A=tpHHY?G)cR{KQoHt z3F7{HE|xExyw(9VGUq}hMlGN$kcr0px&mGjo*&tXF~>_1x8m*yI780T{(F&o&p@^O zhBQlOAg=DCIkVGl0doRPdz1-(mF6sqtLu3pue^Kg`Sm0I*nRO0S(bG$+#S^_4^43a z$`OGw?K^?^{=&y1MrH$~^;H}k3-blh&h$&=!E)#zv=*sFa>P#YiqNS)X7Koe=(l|_ z3UJ%gVfKWX3Bk2UV!xMf4kBR8og8)nba#btocrp4Da_R)=Z{N4j^)=>$5##z6Ty1C zA(Dh{-*@I#+)UAi;^g?{NKY`?PIFj$u?zj=u5{_l5b4TiYRzn zo1Qo@Zi7=fgTeQ|+rTc2ia&nh zZ`gpr{jt~>dLZ|opP6h2NzlLf_tSYrPl!Ej)WRRdcbZN)VET^5^^38-z!gm4 zR!yk{XZK8Ob`t&YYVMpn1v@6->DuEU(d`5Rasr(;2VAj{HDl0z#t`E!QwvI2d%+r7|KHbar*qYjL+dezub-v7s|WL&;sjr@q<1 zvh~+LSsn7Ikx=rgYC;>kxBpdon^^(FDW$vX4j~kT&->-VE}r;fG++-8df7g2_-SLXN%1Z<3v;|^e^laOmI?4A z1pi)g7YC(5(fl+wb4;q)tNLiKJ{-Q|xPD&P0H&r-i&+>E{S}@RI^Nvks297}@Fn5* zJav1(!D2`rPqguBrm4ChifYWg8Zm;$(T8G6%B|sgCDmRweOr_}akM(`o)CIb&3i{Z zu!rsst@83!#<**1O^WP;KT7Z3{v%&g3J268J5Z_xjM%r_W?($pDgSe;6nvx? zBw6IkKu@}qWl5(Eo7tNN(}Qlnv`yF9MB?jG7rdQD_ax%zqO{STt|m}#zx?AeRXtQU z{n@eCaljYKvj$m5s?aZ{nQoHe5;RP8KTP@51{6Dby@JoPV2JWKYmZMOo)X@DBzjTsr)>-$+(2 zvJyD`)U~pHrsAKHQ!8v@3Ao($B&)U39L!m@xYF`mVSaGwN!phrB$;-yy9PUA{Ut8$ zRkCQPijJN9wpxuV&i^K~E6TBU&%uYsa--q!9_v>xM{J?VCn8c8V5|8|Z&UX@hiHBzn^S0+;FN=X{CDF@L z(00Ssl_wvbx+aggmAb+7);&pFs1@EW6(Dy}aZCi-w_qs|eR-Y09;(wRa^E~2k=yS~8 zjoK2GTMGWVk;hVq}7_(JrY(s4ILSIP)nV(jSlR6@Qe7_1wx^iV;N4 zUxY7f6NP5T!BsoZCxn6%?zF`WCn;V(ibo^Lz; zLM0T%D7yJH#k^r9Wnj#pHXOc>M6Gs)1)>^VF1bBxEUG&8`IZvctNgBhWRsI4j+ zFDXT!S)Yh&-8z*Z-o1^_iTJ)&Vu&O6O{9m_Gm`B zt0F?3g*l`2;*Sf&@hwMwPW*5Va5i=Blo5V^&M2~MJyH(7i_Vgxa<_yH$Fbp-V|kEU zAFP-*AB1=AifvM)CS%ahVb;Fc7_j=Pv&NgA06)&I?Q-o7Lebm*v3NK5B1^{;!L^%S zMD9MhvA&mt)%2Vz%ARbXng9JJ=|3k>`xJICg~tvfCHbt_%XqvBOx%w{?s(( zj5`b;6nj^-dR)-)o*Uk&cB%{k1>EC7!4&R2KHnFbum_DJSm8hl3yG zSV#X)FPLl3l96JG!5o1)#VREF=N!~!L`R}P!r$}vnY*57n_SnamFSPVErhNKMg+mc z*Q~CFIhMOMi?L4`;0N*UHL*TJ=%wtu$w8}+XC%B;CKHKXx<2Q5{*`s?U8IKIz=WX5Yj%X zXK;QJAaqKZg%@7~@YDqoYnHqh%UeE+1+2Hc0Z-4FZZ3V+YLSuyq ze$sx2_nP2Y&Txu8F&Hz+>_+QLR6)Dv$2mHGKNt}%3_V3-fg!ot9|s!kkm5wIbNPlP zlt#YiIw-A5l?y?29sYz&Z#6( zqKwNB;^qaQ7J?5fa}zdk}u|poV5MjYyyd9S6KFuJb?lZzLYa?!K)W&R`L(46V=yM8Q z@GfqTac7e-c>K&_%BpoorboiE8v%qrBh~t`vz$F>@0%TUed~&4@6))~J}4u7^?~Sc z9&fn#gPPS_UK4LL^86E>a>L{CJ%>UgY@s&Oq43rTThOCyA*D(ZeG$#fKa<(TP&ubV z%goCT${W*M_cJBmOX8cmRGK`S0^09-HZQmb$lR!+|#6S8w-M)?Ec=l^{WAqACR*> zOYpQJJh#-xzj48*8*Rg>Y0miVKm7rryXvqfM(fKVN`g1X5Prm0$q1{9R|NiK5j~>* z8o8P*hQL5jQhoPbfz|sd|Nf+O!TXlPGNE&=$iBFo=xBExbOq)sT~*WIT_4#(hD-tS zNGN}!@~wl7q?yrKl_Hoe;(KtDR0Z_~zrOwc(uj{oOW4)V_T6QB8o=<$*qa<7 z!oMdkyN8#p2-j+i8OBJpDE?`V^!HFcwEas{7dn)OU!P88>j|94o;7s7sB=^f_3h{wHtGL&Dng69h3j4FfKaQ1H>$GN~_JZ>p{ zG@X zsg?HcLN{!1?pe|CsDhz}-1KW5gsw9!*&(u?i>^|A0%vtHA#t|V&9l!Dwy64ZBPCPu z^!*t-Rif7=xuNk7cWxQbT~$59cQ^!j=}TYj=L^K|<>HUuh1mir|C;T0auT?ZUOuw6 zO+ZTa=H+yOG?@F;VbEEZ0;g!d$yD#n!J%ZPXANW*QTS7|d$CR&Ec(&vZ=EiLAlXav zUhjx}#pbkcxqCi7r8{9ZL+});&q*HItC0f)u*x^LjNp;KI}}pQoj~vh@+$54qJSsp zt>5wYfpB}S>C%$FA0{50bNZHTi4Lyo(?czxU|iNf%{Lc@G%w$d8g=ENyFB-=HqUrS z+L3C%*IxifG%tRBY8{I`>MhLq1=)CfUjo?fs~!oq4T0a2{o}grA;@yapg}2@ z7SFK-+rQqQ1bl6EOGba=aBe5ZA;BaFqub$k!zRIhKfJyiLFfY)*IuO0q(u?AbbZp0 zgA!)d7}PWL#KJIlR^1@43qGVSe0g3V7Q1uFCdX|2p}_G!R;BAc;6>P28 z)lYvG!XJI56#M`40STjebt79PYzPjD==1GLJ#n__d=SuYO zoWM&h!Z_6TyQ13A2lyY*K<0Hbe3+>G*6*=9vWR?RlP>m!i>hfoKf|5DF|IU(TqGEy zdp=xvZDNSZV*G4BAq;xA`HtH)DPXdL`=FIk5IWuda?4_b1j>&dcgpPcf-v>%5g9ob zv^4$VWaFibnIwWZYh@4jogDXHK5dR2mn{s~N0m`6oXWYf#ToXUunpY^!s8~LGWUGy)&Li`O zn1XRYDMl&A^fS&_Sjr)^}vMSF7qBcLwrl;wIavl4HE4vAJmB6owRS4 z;{yLWV@uncd#WNH&{PfTE^XW}U}vo#@Pqo&H$%79jq&#JgV*d6d~mokPn&Yg6=Ye86>~)#V3p3vS+dF( z%L*Ru3MWZnaYHNf{AF)wwfTTCKP@pqEb?9-asLs}zhE;x?gleGJQ<0j0IPG$5;6k5 zsH1-5gTB2f5rP5djbLxMe&)&9o?kB5R#Ixq%j1NG&t6U#FcQ4pQ3Z$D_d3x3p}4dm z+YJjJcE6~ZR|dxHmIB^sTln{en~(N@6$ZR}|Cmfq2$eY${!I+n0hL~~oYET;Jd_1+po?|4lx*XMoH@YM~wjy*^mPm_ce+q&GNE6$KbRN;=Mn4*_J zC)Gl)B?d^}&a5E(tYfvhv`0_Vfkov0^KL$NsQ-Jd&^*)(c27!cp|d5_I}J^?)i~kn zCu9$QZ|UK7y7kI|uP(647$tSx=mdm5K6}!r*&Z#{pvm`;B9wo9w?18`28vGiDIZaGia+SQM`_D`>YA5bhy^o~n34N4eeh!BSkk9Ghz1&_?`h#-Nb)V+uym zKqcH<+1Q?n<<$OSLb6pb*Yq{zh*BM1{RUcOyxDl(D?lnyq7u$;iQyu(54db~o|z={ zY>k@jM5oWODDa`1lK*fJZsxydRA5WN*_GihlPB!KVC$x;F|#{TJy>wjKb}hTY+N3A zQR)P~zb<(s<;J7+e#Mj9>Vc?u`JRVxM<&{jD?T(m?S>^UALri;Ey2A5-Qr1Hp?Hmf z-Ty~h3Dir!KDzf-9;h}Pc-2Ughy@@;>&;`{TR`6^6Fu)LtE6X-|W%WE$!rN~5~ zKv3ssAZrekJ0^>idvJPu=wiAVO#JEkd1#C_suLwQekAz1Lwx)DO^>T6BuwF@Rqb z+tNWHct{>!_UBPFT)Uq@b>n&tF~^$5b8{NW2_P6$-)|{l z0g^QK_{TX3<+dqhdP}^(*N*1VHg6QHO8ZqwN=Bovy-T8yvJ0-wXG=HnrofsXhns34 z!C^Gpc5M3>kJlO;#K%V zogWKCao=cTUkvitb5VAf2jhawli&PiDR6!AO}JXGE3~$h%kyQYAXD`?>3Wn4dMHi5 z82b|sC8;4VGLG6~qWtw!b=+P!kgX$~bJ7nyPo;UWuG`@g_DA)U9RA2(CHG3W)(`sW z*?*nf9SQ?JKH7%~j)YY!z3+$75ERS#Wb!pU0SqP<53S1jLu#?gBlE!o%!=ne;VUGM z8-2G5UDxAbeVn9Z&S8(M5g`P#6Gqp5>8QBeK4{=3cZ12;*M@Qr|luqq!v-2kUazvT*q@19X=iPCt zju>bpMcY{2^uXdLy98;e;*tC5q{)(=FVNP+WU2WPzL3n#zi8%67Wv^b(L?PAJ7 z79}6}@cTQZhzXH{eN&kjV&{lM4>D@I*3Y4OY!X+>xH)LHouyu%aX@XkJcDCLh(5I7 z(ESR;oo4(@&K*k@g4h1IV|Gx;9e2+iUS>>l0N)$0#Ct^@K=^ET3`Hlw879{^2+!8S z<7E}SncW)b#Z+ey{EP4lk45qq7}|l+TZXu%TxX=)uOxBsx;;L2v%I=@ zClU#hCd#k zFP-;*ZWDWl^BBMitazZHJpHlUszzvMP+djN_j?gz6S*a&)nBmEA z(;wLb-mn`7A=3MV;(>J;gkzL4Hn)rNbp%LMQ&QuZ3Tef>eC`U2{-T^9aO-JgwEyG9ot=^ zkF(CY9^3bWz>_Z5JDzw?K0lu}GU@fiTwSU4Hv%qDu*v6mBSj0^oet*wBkrAT-kcE& z&1P_|WP{RrbFLmX(l^4oZlM5ef zbj7ZiD^qfL-te&IwPFXG8O%K>p*3@J#kuYHVXcR(aPh^+p~r_!CNl4OjK#mw8*SjIsP`777L5bZ2_`1D@kFECL z^=gUIuQ4$we4p*km5X;EDrIei_HF?zKl;Ap=-Pn$LQUz7yo+(4smYB-g~rKxQ(VIYhjTW;fx|rIGWgLa_m)T7!J8ND#V2}72!3c}wzgyu$W^5m#%nc02}_5c z#`#EmHCJY(=UNTF@?Q$IUbu(?V-yD^_m-pC`8$+ldt)%0;@Hl3Lk5aXlO6K75dw=9 zGR6;xJ4P~7TYI>dKPcy$nVwXLhspa{Ej$M4xVn6r>$681P7Zc;{fMbSIa-R<8zpHF zsllahyj%edN1FRWZyVrI<9UY*hr`kF&=+Vpo{!p=h2MXA=HblVXjMv)P$(+DI&qJ- z6#ixf-CkFW2Ub?*FJ`mpc-ncTB2+3FTJ0}uRyzgZ_eJJgtF4wms_2`ZX9|E^H5-4O ze}$lRq)g|+Um~Ar`NpSpgXq1G&$lEm$%eT32VCx(1ZP^p(sBQ#avXR2W&JP617#0s z(4D?f3*6G@BK1irNb0nGebS`_cgbB1*h}OyNk8Z}6$oDEwFUkjd7W6?Ie2pQ%$qpm zV|pR47#0hTj;8lU|07|)0{^oq@^s8vNPFQ;83V0kzXo5ui2z_*vEoWYZ&gSck+2TMFQ_NvpcWY)ja4^B5FY<&5xj$I(Q zHshR(7qc5JS)BdgYfR>QA?b?{^Xzp-SFRt<%pB?xNsPlo8h+<}mQx^(Bau5+VM>5jv$!VB0GCD8{YVlc{4OwBa853=F~GO$U5e`S2M#E?#!{jpV>`t znWv}L^AAN}h-~mpU#^pwovzIG>uEgrB-N{4b+pHDWrOmQU6JT=OQ_#^HVjtz77xX8 zMnZ9qRSD}l4=Qa@OnV#(MH6cFpEub9;l{+?}Ku3VqOU> z7v8NM03Es;j6XEuplE`t@1rWgLHC{MK4RjChF`oT-WA3|dp)O9hQ2B)u<;kDyiG-t zsBv>bsx#hvi_(n@loMI&$ zQ`{ox#h!bD_Ns~sgBh41HnOmchE4YMUEke;k?z=l<+;7VsCT5Ni%BXR$g&PFo_OH_jIw6g z$AZGq+B#g3p;-^3Csa&0ItgCU6Tu)$VvlVq_A{F4xj^&-%3fn$bcPMCp}|25FTCq& zL|sPdgbGFzs`+&Rptyd9gZ`>1oO|h-d?g|rFPXL;Kl@h=jGTRz$(e}H$?f;8bHqJ* zeR^`9ZO9&@3+iaY4*No{ME#XLe>G9L>p# z!6?HQmXV@k563HHv$~x^Ada6UM^GdP8TsTo???vXjf_X%w!$NzSjjED-^>}-Ubrhr zI7VP_MSIAXgCh8}C5tJ%F9?(}Q_QO6iQePwq(Hf0XS^v~(fas{8;sV=`JR1n9Opfi zW`y2&Vfp0@kH7Iw(BIV};m_{`%qfW}#_hyA-FKHR&sPn*gCpfTHoSm^{qiNd8C$%} z7HuwBMa*r_X6HA|ePKiCXHgCFFwr}F_;zQda&{m{g|qKfCHH}&sj&<{ z9tESz@PU>uMn-t7_C%0ad>|~24{Y;y>f_*R8-+(!9{BwS7ADZR!+Q3C!Dd2-&(Jvi zE|=iOS#%xWVDmDB>#y|Vj=lGR=f+?E($xL`4x^aXF71RDcPOPU$9jPT{ZFF@-vKtM zAKs92a7Pg;R?glbGnn0$df-WJ3(RrBUv8gv#|ye-Iy)uDaJJ^t4&^}~_*iXzc#hc= zDW7$ZSv7f}sN|fup|B&wDtx2z$g+VI%lM*0DNaZ^%}M_E-zjK5b2BXO6bVBAOWo)q zeBUvg>O-iPrypgy=d$btxopeY z|1#V#A@8vG%_IjrD*Iod=><2qK=r`Y#Y`EN&*so}syU#i6}f3%njz?<=A5l;(t`*M zT{`iHjySkIs&sZ(41UTU$dI9NgSG80jA1iD#!)Sm21953HGWg(E;|Y4R4N`-Y+Aq$ z3$^tpIXldx8Bi$JJcd8cu4oF~vH~*G2y3~krdT}4^4~p5Jsf5i%&OROgl5w5>c}IP z(W1{)-dMj49@%8fNe^8`I(006o|FM@YEzw`@;hKxrO}eumkQ{~TG@EfT8T%2XW;(7 zD`;>?yQ0Uk7;eW!Mo0o!4mmo3M@BUf;Ja|jK z%jpuqEqJQhWf4p zZIr_uF(OYLb)@W6vt$)I^sBR8HH(JMKjF6Gq&!gm1V6G(vr*qvZQ}L)K>V@gu6{Q~ z4f{X%5A5_2eljV$(S_4laNlgeZ?Q56U#aZs7bMGv<7;^|7St}_G~)E7fS8ZUWLowK zRmI~{o;zhMMlu%3P7(Xsme9M@s!KRN%d%E})&ZGEH(k02-X^c8|CC?32Yl}L zE&V_W#jE?)t;E&BFq%AgiW7^$bhzN%+nq51tZVrgY zR^Iw3QwkrCpLuLtm4Y(N&IV&I?D1{aQ63NF1UT5VXU^kW0A|Qd?siGvajiGKB~+0>%AIr1(`{k&Z)Q(`0-Jn+>4mwV)i&N1oK|R=}JnX zlsX$sNM2HTQMrWXslU$fD-L6eL_EiceO#{E?-bd+44}7RvA*`3;1XYd?fBdV}`BX*N5Yg=F)1-no>MyB{|A%4@Se+gF%Kksf521 zM9;n>CE*DthTbO)X1J?_Ho37l9v<8LXz1kB0`lPAX={a0WP4p3)=u;^%>2jcNB7GE zzBc!6sE%nuZJ{unDY3!vLpSq!ZS0{s_iRKek1I;4I{v!V;e$OXl3R)<#2uPpt*AoQ z6MUtz{O%o#!5PQzUM>+P#6EN5>jSq0&~0cFjCM8#+X?>3qRj*(KJ6{D=U&7e-tA

6OBho#Ban=hT^xcrlZU3Y0yXYV)Nu-2XK~q|AUW|iB}%wUD9xLf|M&K z4r5&g-1gxd=-L;6c_E9F{KQ8-_b6J$;sS?O? zIW$MJB?EDUNpi>gzvS-A51b{Z!ya{S(I-BGxa`?wnN8TEb;3f@7ns}AjskTkKwh4A`0l87$xoaVcFQ` zs^~9*^SScC=4h4^;cM=j;EZy|%q5?%EWC5vb$Qd9}~9VK`h zO^eD7NRQL~0 z=G_Fklxl*0#s{VyT6VV{cEqvrW%}L`2UJ$!4nlo@Fu6=2LlTsNqpLcB-KT<(N&Qjh z`4c8ERe3SkMJWJ2wM8`36TB~_g*$E8yslVtiMrG_)(vi6&bfJ~Py?!ZoGZMKIOC>J zT;hu{Vn4Q;ew4^#3ib|Rez|lmc&|h6fdnHTjJxuMY8-KgV_>_Vn;hWrO>t7Ssv(#zJSX4%-VuYCGpcI5WFRI{E=Wbt4#sIGB>pXsuvczD^?QUK z-U(l>~JQ+y~r(KpO@?X<1>f<5L}{<*Qk zs)qr>j)SvWj_~vn9${dA~$A2 zes`_+uTpA>#W}lzW-yjF|)4=>);>r^Wp;63JhKU`dhTT45{0F!}I^U1iON>#Fq#zf~L+`QJQrMh|g*S zJv9h{bnz-SO?!Q;ovpbcmY)SRQ}^~AjCBC^WsfVRw$Zp_IP$PCHUy1BJ1^hJOoXd` z+lQUJd||I(jleEqf8Q09QLQN9vH}W~J*BM?th+Ue@#4MtG*@zW{arXy9C)GTcr4 zdz1bmsHo;f_#{`WyV?_+V7*c8RQBIX*x>csUxbv1dz#)Y$bT(`)C54&(wBQBw;2nv=5?;0%^zNI|_}e}Naz6T$!1qC}lS9vFN` z9;ZHV5vAK|@-2wZBPRAS|E5C-6K8+g31Gyha!YOpyjm89Qn)vtYfCha&pOq*32Tlb!uZQJ#_v#B~v;MT+jWu zq^SZ^60hGk67TzMx8dJW6bZ;PCAlAnx%j}4%ioxHxxkC^x}R@_qJmcGq|?iMG%E`$ zyGb4fu700IU^NcTRB>=dpGZYVHtr*mgkBo#`76hRkMM<*U7WIxcLy6|xkY;7>(&zD zc?bMm(Oc;FgzPxs-+Z!8;m=3x`69skMmqw_ls8-CU&P=O#{ z@>f;egz&3-hKUYb2*A(xhg*3xVu4BXz|mG>|McO=psp74$3Lad+oR|lk=|?~M^BvS zH+jl_a*W0iG+#&X|JUe=51Ptz3qEUu+einG`p-z1)0t}&mT|yW!bN0LA0J&F!UD>hMzu6{;+9}RN7IGI7CCxUuRhH zUWyx7pYuxu2TM2~p{_L%_upl^=y#M)m3gS-RRwtx;&;ez> z|NDG9mEc<5&+qLB&_l29i+!|esrbXLvzSlS8K}BBJLCypMro+h9-ml(XK_gPyv3_< z+?#!et)D3xj7f_}A_s~kKFUZVJ891dz)tWRDOy;Q4> zT3acYR{W$t^@+G^^OWy(;4;OU+#-d(RyT~=pW1i(fgL=v`nY;bMvdUpgda)%ZG^&g z?)h#X?cv+!bk+W3qHj`0nS#tL043p%-xDcg=%YBV9emy|&Wo$fi6b9o z2tKPzKXo3FUyA(pVR0-)7osNopYPv=1!#_EbPB`q|x35SOueLVkrZ0 zSHwGd`*VA6vhU^NqCNg_q)ERus^1>P#^h9HXPi)KwfkoSoj17NoqrWrCIKh*>Xsy; zH(pI%?Q@OEOGyhy+YMaljyh_-0pvst+|U&2RxBgrY@tgj&|of*$I zfA5R6&$c^MSlmG{^ez$ca)j0wP1}n^Zn8;Oc%w>R0R`mV|0{Fzho%WXP32J&ckHr}^nTJ9)qG8rgIt_$Pw{#(|Gu3($>c<#kPH+-pN z)-+OJgpvB&8A!9C{{9BV!VYC;+@rh5X=$?%EP`(O(=+)d?qj?kSVys1MDmN=pM z!B-Y6MRursqxnS|r3;Z;e|TEK>J${Np82!EXpaopOO^dMOo8Q6wh`HBeTde+tE%kf zfH@N4(f;@4K&NhB5Iv0(6j<&HKBP`URaq^o%rsj}ex{qZ{l*2(uQ@Y5XHtW1yQFwV zOLt69eQxR@rVNKDbH{!bJ42r!KZ^&KH41)W?c%MpAo?HWZVf~_!1#G}l?@j@Sec>W z|5rnBrF>S3h2{;wOrCy1o6QoW=U1Bw90>pCAgDc|RV8@XCmuu;*n^|^&=c};2_kQI zrr5Qt0^+;u-e>n#2Xu}}2*8M9G>l-!y-JNZ~<#{B(a?~AEs+mJ$C~I-Y zE#Q-3Vgc@Zy1S{jH6A-A$;w6|@*yH*>X6TO!dEsVz^a#S0>yRb%yydz12_E*8}@<< zc)mz&cx>Mly#1ux?YnCgx-#Zo=w{1>BfS5Z+0R$uLv~;KemDT4Wyi-v$b7;5`XcG| z=0yyu~zrLC|pFKC=KZ&>A_7-t%}Dht5$Jx^J3NK-OD@y+u3+c-><~Qj7y&&v-NG`+-=T z%eCk`z8(iY|JC6=A%d^uSJS^>MdZ!el+~75vcXdNgP6EHvN!9duZ^Ej~nbssiZ3+ za|6o)E(RU-Bs3F0SHKsVf@}{nAHTfo3%`@hHorOMLFzk^cCXm^77xM%x8; z`6m^z+U5kei(Vesd6>?Wp9lxtr{8v8F;7K{3y+V;`kDdT^Ip~hpCp1q9&&Skcp5Ui zFOF1YcEf<&%Lk%~yf}-v=Z#;p@o=G?{da?4HrBkJ#4|=F7|<=q*?1=pcC%hP*{AjKxJNTXH+|ur0p}N*&@jxOvhYn?OGZI11-8d`LZGK`?aMB% zD4-{~y}yQj*wt|@x!Y9>9T-vW&`T0%Y(4v=(n#pS9o=FJ-G0#Sp6*&{K=hDVc?Ir? z2uAjm(JcxZ4-_$dVQ&6B0n8*f-wCLZz**sda}i@WCX(+y;-GDhoMH9tMmHlMCH8aQ z(?DaS(aj@~$A#dffovMV-+$!t=Nu+ZFq#m1ywcMkBDa@$-)=oJP!qIgRGYFFonY$Z z)6-cu{zuVyIAYnhVO%y*$|yxinI$hNgid?!z4zXG@4feyl9?1GO4eBvmCA@@Cn;2j zG^l*{_ZRTo&vRebIgaD_`CyxdV_v$42VQY`N9?NnVJ1q(=!JwVmR{)nduhKF{JAU}|_{$rhkc85@RLVO$ z{#X^M=Mlvk2M>6zKD@PM2FJu7N6(k~Vg_GY!ta0laCwUK6giQDr^UNYmGapRUzBM` ztz^4^rHK*rr+R~Q(~kWDa~QVHkfa19d7x@iwz2f17|0$}I*>|l0^=mgUz}3n@I!20 zk zqI=}mA}_(;9dh<_$35XeryJX!5?7?yuP^VhNd;k4E)x)<{vGIjb>Z>#)x~njnRqWle9k4u3Kl9 zUv4ZvDn516BS@@iHJ6@3SkT}%Bi7s?bZF{A>o}aYqZr+6n#UwKINS2%TVYvGH+- zFn_$dWq8j0O(1j%%~_Tb`?hhWVx>{aV3g7>i7qAbxyAW>Ig4hAx<}bvp^)1EUG#bO z&~G@R<&VPszb`lfr$t+CHw%GyjM>pqa+Cc~X)}M=tKFHvk z*PgT>MdZtFZxr40gPmQ1;&{{y$*I(OzLyd80fU=}Uc5WVFnX1li`hfo_|DjBn-99b zYH}s`F=b{M*jy8>KK{cR zyX=d*xrS7rx_X23>;rXRirdWF2r$9vyN`*+HVhp@^r`^6<2C#>4%L9lnfwZY~~p9?b2}P)@Iy0KAP&@xH2$`zD&( z653=@?4PE0Y>5^0HdFRbINrg94WWT&n|W}pp>H71w*cI%%(OG^S7Q0OOfT!71t4o| zA3$ATj~4FV9*WFYLf>Y#`iNdSk~)v9HH}9?z%Si#6GFG~C-L5+LA^-e4Y_f1F{_Tq zUt@8$z8-*EbTRDSh)CZV7qH9 z6|_9^vi2(4qWFK0YN?4i&v}>r_G*DByqs)xggP-Bd(E%eF>EE``TNHu{v&b5r0n_S z4>g3(Y~zZ*^PytcGqs1@E-C_5j^mDHFns6v$-Y)gl*(ML670{#*4>B~vjcwc`R-A1$>d}Z5tpL-JQ4-gB;9oPn_>`- zG^Ul)M&m&X(*q2)c@WU~I`*sran9{l2KmY6V@9F)V>*!_{A`+MIh>peW0yR<*1tre zRqdy!0MlYr9wj}k=pF_-3!I`M?=s-W?%Ru87=_#%0ooqVvT*u_(#k2(Gni9!4RC34O^rIiHeK>aQ zynPxdn#>0RV`K5SI1xv+|pTV(Fb7 zU$&z$Kz?c5+4HFb-oC5yRW06&;MM)^dVAj+>fmkIi~SD39;=epb3O#=vj$$d8e8Mr zsp0nlM=wFnOPU(y9a|KpNxa+fKi1;}C@-hsIcMkpQz7b9E9fIEM z=?#Ob47T$kXMN!Q?`vcwf!?@s*o;E;mNG2-&~@EI=&n_JUCQPf!|*~1ZN>_n1z7bT zt=#rVgk$k{yxNunkeuD+^+ISI<}u1nmF33(&3XpiqnZ%#qNsiHp3qfHzcrU4=P|(G z2G4nv(w|EXM@FqR~?}X(GSbpXOA=G4T*=f9s}H zV{MHMk@00zgdS|FrQG%XF)NJS$)cx8az~NCd6SF+Z)o{;iC_DMG)Rbx&^mq#MDji7 zROsk^;hwv}*EXvFP=cJhgrpypeI4^Wu3O@Bwc{LW)N!zWqD;U2oi6&X3!kGRI2z(@ z>~;T!Jb^~99MTy>L2)~`oe}(r9Qx_{f08cv=-(d&*y9g7*UrB%1gn|gn9y!u~$^P`dw@YuFHo^n72$sf_l)HMWQ zQI28Mo+&5jQTeZ--^~Ze#OEu!(tU8Y>Gsm9p9Q9cbCiwT@`3)a&Qe!Z0`P zNN{dmpZXQ!2{l6t*LsX3;nl}W(6Q);ch0VwvJ$#=_7Taff9L(d#`89bwy6&${$@NO zX6S{QRj9}Oturi?xuYVD zY$*{nh@A3XV|fRN{Z5|prLXfQXc>M+E%LS_Hgp?jiyU_&^4CMp=Wpu4&!rOE&L)R{FCxD0&=Y6ZIBgA3sXpWl zl{3KwBOy0;_-+gA$M5Rrtk}YQ6ZNaa0Y@}iqJOMJXNYG#4{qEsA@Z5#^@f|bDIoi~ zXN*#;6(0WXFge&t@KPu2X%bDfV7G6u?97f4Jma7S?obMIgT!6SBuT z4`3rbY5NK{bidFV<0SOytU3K_-?wwXt;RD#jjsfCo{Taci?_uoDoF>Y*9jn|V%SV^ zi{RP)d2_VAtq9n!{ny0ql?|nWXR7I^ui;s_*vnR3dAPh2C#WJ^2vxefWXoQ*n9plH ze%ARa?*0-vp4OQPF<^G!EmcS%iO_2{LS_?QRH?m7+kab%%YqJ zlt~)h(z$lfmYn55QWJ~02{z>fNe<12oxZWX4F<)zf375Up>XMW(7|Ro;`iB}|0G{C z1EjO7o)q;4!OE&mI*UUNmKe3PIP>^I%2HdQ;|U!+DfXntEiMMwDD)=|Kgz_rhqF#L z*JPsjnL>kK`K7>GE#RTjY7fs3AKKnjOeOY%n@7G$1R`D^FyT8y)mG z8cEX`E?mlS$TRw0>5rpK2Mc!&n1jp1GUMByVquf5;Evi~7t|dYxb(a>8Gprir|n%9 zN8jXo9(imT;L%+!xs>6DD)KCpg(Gq3!NvQ}gr7L~^h>!X^`oIfiU^U~jmAOaX^D7( zPZ7solVdj*3rzHsbs6u1z-NZ-{KtVr>^Yb+ni%PV=A?TG1ZOlnsGAkYw6#GlhL>ri zvkG|pw6LIGs2y0{$&*va5Cs;x!3S?6Y|#Hdi?>%f9dUtrx@K&|0QwJ0vlX&?!9o3W zUA{Cj*vR!fH+;|w*^WK0ZFz2jBJa~wLy38y?7+Rf47o1w?_a|Y^^O?y=QC_b?e#$Q z4>?}z*@@uvhxeHH2Y0xod%1vAAq`u5@2Z`OF@|2s!%b(}Q;7T+Y5o&k?l}9>sp8d# z1U%;WQ)^s^n6Kswb2o6#m%@(^K4Xf6E1aLNDs&%&{&RkU zd2QaPbOYG`SolJ2+;UOv3tP}vj`=J^6NvQpPww>%l?7V9i$|3B!(hp*gxSHy4qq>b zINAgT<0<|SHrHN1XqkKD^Vh_M;EXbT2^b2(=J3W}niJ;i$yrbWegWd@t9Fcy9NSrlc>#YoI+JM@YApExHPvam~5r2j28QRV4;ZLH4r9 ztP#N}GkE9(6EF~Jk4Idm(|4w(Sy z8%AN4FaAi$ao|1I0~;U{B%S>9&mS0W_nloC^e1?ee0|R&h*-5H z_Tx6A4W;J-@p}EfKsFjVXuZJrXW7_;;H`kufpq7r&wFQIRbyKws}vo+f09Db@L=?n?v zVZ&_|BxvJHa?k6&4vGf7F&@2O2AqP@e5);bn9)JTVRpd|=V++4N{M{2u2z-o7om%IMyp+ayjBlI_!C3)-w?V$ku3$kbbWjw(ne~WX^Tw3Wwr0UT|vb& zj(PGJ74*ap>@?i=#@gMFEQ-#yAl_-`XT9wOkL)516&k(Jqjg{u+_45#jS zK|JqPr_mEmP#-28tzq;)5`p*iykZ7mKi2Uq$I%v&ply|Nzcq@TRXO*#6)?=Ot*~py z9E8`};cTuUwzpsOA*s^FD6MTZ_a;Xe$&CNEdY1+FKUMTzJK~995A9rr=?&oK_VO(X zCQoqE>|Srrv_bwt{R;C!;$H5}t}7z;^RlO=3a_jgz|nfkYYm(>=>DM7`p_*NxLPN9 z;qq;Q*RbzZ>ppMd{*F_;Cvis_oy;3QhWXe4pYnfvl?SA8@UzsBcZxRH<;Kz$p>7B< zXUE7bh|hneU9W+a_`IFviwt+JNf4YlnXn75tznQuJk2{>nc(!9SIurF;fJik1L^`* z*q0*IU2)SL4s|u&PT{VEN1-=rWnSh2~;JUvL~><7Dd%UNF;mcbJ*S!dEix$xz$*?#h-GTaKck~GxMMc49-`GmRu^L)h% z6soV`&}GZizZ3CDPCr>+!sml?-!g@k{0Lsr{dX_Jg%gotg|@J{DHGm=^ZGnA&Osv? zLHDVSFwkK8BGvhNqkB*z_MM-6Ak-4m@`Bk^V9fKadGOGMnCGi{laqy_t!??$#S51q zF=NhrCOrvF{eQI18pY!ZX|71-OC4-E|0C7ugCF$RNxP4|DTJw3JKn&nJPNc%DfU+dp%lcx!vjoF~h}Kg~|h7_6ieS|+Ha|`XtH*=Xumh1dv{xD2Zk6(>7iPEkmCgn zCDru9r_9kaMyHP9mnLvN3egl)^F^7*UsDB7c%j@4%dk^>Ng%7uQIkg|8t%mH2KCNZ z0L`(6tSE{IbZzwd6PXi(V)L!fH6L5S>-Du?-z)53CNgQ=w96kYw@BaE#73fr_O+=i z#QQ08`Fh_)5=U^P@2Wde5sfkrl+R`|_~NL@o9=^laga6`vBKpL3qou?hpNiru&L8DN915s^xw$9V z6CN(A#8hz*|9?g5-bV)m@YDHZg_m@(D3#2N7wKYv{l72Wf64>FsNp5E-eMfecI+>? zl0fiu6YM-51`_+CXO@Q+p1I+cZq)10oJ6!eCO4r{91PzE`sODSB7r`TdS)Ov8V&mn zi6;n;pSao+O#nzz$wFs+)FyK$mFJ|PSF>QPB$f!q%Ooms{H3&o#Q_6aw^QQ zcQzJvWOYs%YjL3ZLXFn=!*KZPp>^v=ivylMvM)iy${nRb+pLP2ePDBn`t(SE92fZo0eT*!dx*@@i3-N|Mto`0flPhh@9w1zque ziR9whU#56uc5iP-LIA;mUwo!mA&o1MVpA!%g77hKWO}QSA#pGHudtMB6LYB}mK5a&30=nXe;-E0z0p9>qomQ*6S#G_w~93!;0&4S zea0nE+^cdsirPdJ|B)=dQ&V(-XtH*(YC&TRjH-2Rq}9c;N;@S9PbY|&{POM!iza%N z+&Y-#N1MT&1*HTZpgp}iT;E0H zgXNL4@@%-G-ka~6?;M<9^a**FJ)HqeX=q5}{3naxEq~bk#C3in z-5GUW(c4S15xH?WN3NR^^ytM|v}mMTB3;9~GUMX+F|P2Yfy<;cg_Pk2k+PSpV1Q4o*+~Ugjms<9WutfjZaSaZ)?C;Qf*v?0kvRO3`!z zJvxRTML#@H`7ZDuB7F5X$ntc@jJ&}!bZneGMhem{J1cSb5qT3|aM!3(7E@-vI}X(#LLdL5;PARW(O<1Fug+g+F-PCxK<(jOQzU)eyvt=}1FofM z72iP`d?r8Hy&-h_pY26A(`TfiMzi4fl_C@PQ!p;gEp32IRuIr7AV2aWAQlPC(ax zX#H6T%F?qzNXEozjinY8PUMR|oy~+_Hx{zpt&~AYo9IAzzWrT|RP1<}Xei8_2xjdqdpDP|;GD`I zru3Xh>>N}&d%%nEhgE04>u-$%rG>nX_>m$UElx6e+8T$sj^fASf7qar<%?)r`#eYy zpBJ9W_rWQeJl}4P093<~i~r~>q3{W-hZRQxcsy-=NqgQ4KNs5OeK{V0dEr_DAGm$7 zSy#?%@s^l*X<;%4X@J zSctuy(2@P?6toVsxRmxJpz=()`It=r_9^~&sv(gK1I1Y*Pll7g;OLBzyGSx#r?_h} zyqJJ9kJ2Ld&iKFyayQl8x5*Gt#TMsP9)n+g>e&r!g<-wITb_ywmXOcDKi}XM4WplT zn&#!*Fv6wv;AwtWOi(uNJ1leo-erg$O#J5uOtdebq917KyGBQpKaX7T&;D4FeA9qJROPe?t0{6_NEmADCF(AE;zw=`l z?&GOY%dzuD3^m^LAvui<-ZWT&eA*;t`&#I4wv88D@23g=>|c6!APJ`;+)@D zCjOqAKpUUAFV@qsc0CpFgUL#k{ikQ`fJ^(cA?Igr-2e0a@Y*eRj4Ylgn>gwX%E1(w z%eTFOZ*{`uM=`-e2`d@>rXhkeZf%3CL_Z-NHLhZsC5)?^qpS6M2_1IzV1&sjT`VZk zY^7`thw<`a<(~o8@cNU4Fo|w7YAwFlY2kOk^OHmGw4cR*xKz`|WU2(v=0&|#yG3v* zv($gi5jiUt>trslO~t{}(?z8t5Q24&YF}8YgyZVW&%&1yad4Z8W#SAkp__c^Q*^aC z9xs~>C~JKobauSQMs@@Uo>GOm9KH%crU~Z`^9MwpP|LxUW z4dt0O!prG9g54(^z)yvI+1h~|O}TYg#!>2NzvUuV_ZbfD8L>NVk9% z$ff;?UUCjc^DhZvhxCns;$?zqCNal3d#|>^Wxy5B@#Q~l95cd@6*}YR#6GoO!kYGP zuL4%Bp1Pj)!x2*l4xgycw*#Cpj!Jr`2{D8BmlZmkP+$GU_>=u+aL6t1qmzdN+!nJD zQ<(F>1I|lyH&>0YP`E_F6ntxrUTv$O4 zUXiD(%4@izS2-PjWq}&7m#N9rZ974Uqm*kIy(3;H(>Zebu_NOoyVQP_e@gQa$aX7E6x*Mq#m(Zu`l_sfFX1mV;B{C#EdkS@68=|mR<_~W(ppVQ5S3P4pw>KHBJ z3vEJ|w0#%}u3!7^L?4AKz6lk{sjPJbVXq;T)J+2@O{7)~7k9wW&n(B7=P!b!-dlr% z@+M%PW0@}&ZjRT!zggwVK7rH~2SgrxvxAS?-G_d@G{DSb#+%a-L=J3)Wy3*YP8#&f zXs*J-5`KKO$*5Lx#!HdMdRz}{8r+)d?N;yP?dXxohxyTH{+{elA8o zE7Q}ur3>)nf=b~^A!^I}N3!#V!5Xh7-J{kbuss$%);L#+=HFB5lVYx7M&C%?+v`EV z9r@)~dwv0)AE7LyV9!PRrWFO>^f2t)SXt%^h{2{KKjx}Dv*DwJ?2~J!54jU2vMzgV8?f|Lw9YGi0`YX|H)T#n5yr(XvR|rJJW*KsE8bL_u$*k?^(-nc8a9F zwL2A=?`#?uq!WItN5NvdUs6HNOg3o`r7E6T;E((H%?$Z#wJ-gZbAb}=`3CljQt$Vs`2Y-fxhoZ|n1>=S>TWw{ z$AOnr{MlgxBA3ShRNoQf2n_N~e>0h6gzU5``{q9Ap@k8*4tb_N?*6MOE#1)M8`iW)do@HVJ zV-#lyG1sfu(XsOgN`tFj!(zc-eTe7qtm5;FV5~GXuWhU3mzO;g#G+dBHwNeW6+Lx^^u3%|6|(CVa|)KUfd2x(0!2SXl87vj7}*=~U8G z=RoSi4JkK$-C+JsT5@cvyRCusMsO};g*glCSm z{(dm2i)TkXUVbI&XpN$8V(gc!;kf1FYiS(%_~~f8cekY%&gge4QZT8&ne5Z=ZU*_l z${NGIum?mP-+s{a$bZ2Y)Uqb&Eb9cM#n)$qJi~y-M*H%QtO)$?_v<)E?-z4TI&hF)By1eif-xCAA%4l#`P#|yQ6vB#?Dtk?v2$b1J z+l%^MU_2@AQIqQjW*uLhgmXer!{ETxYzHem*;T%+Z5Iw2m^5b=8$<=M~uLJg!|I|Yvr zexCV^`f2tjHt^+~Z7G|a8qD)?wGSl47NVVYqIr> z>7o}lKe65al_LcH3e_z{*V_T7&t`V_If9FAASw1FN*e8`$>vSwCzErbiDEqY8Uy?H6USNpV2s;)#H@i>Hx_@6Vp@6?+JX-)C$eWq^%; zX{O4P&Cw;gN1LO}4p>gEd{QXoh8iZ4vqv=S@Pyl5^_JUuFum{WqxMN%P@W*jne8_C z=+n(TtrWsgPHkiv&|(iUWe4_LuP5?+=v$ry5&32DwL&9b2koFD`k6?HwhlDktPooF zcS1RXmWwm4C!vV>e*gV*P9V>zO)Jx5fDhvze)zm#fxC^7CWbAx;3BM}ex6Q*$akS& zc}nDw98%iM79skL8FnTIN5b#sln~`|GLY~w=RN!H=YT9m)AQ6hbhT52p8}n|&)k-tnShmk?i|@4E$n`NM%zTv6c^_6xk`!qIF_ADc;&l3 zu<)KpGQVwsW*3jgPxi>+^G~+x!!nj&9}wj4XU2;+Lftj4UNprJi=);JgfFp)(WfKW zR|m?o6-=G`w6Uo<;Hyg6B^03&P78t9j+QkUe)xba5jFtEX+$Qr_l4KV@R< z&NUA-2J(h`zgMhv)(ul7Xi52rT=D8B zS8VHl#^JpT8OD=8uS4M5V|J%Lc)+;D$dnu9ER zKGRb6OMvTR$2F1_XM9W-5~g)R66PY)_iqrs0FDLu%hA4B;AD@kwzDU3p6+MG^M~G8 zuO(^T@G%Y;H28GgM?+w!_rVX92w6yr+|nS^C;YAkIy;IPzHlqmY|JYn7Jhu@cruqA z4R)0d_ZwQR@J{p*I=!pD*z$y1zb=gEi!L6a7B&q5*CMN>_ou@^?ae8w%Y_d3;E6EI z)&_%@H-AFGeZueVyOvN$5{6p=Q_L!hi7)6CIX}Z0hkACZ zTh3)buH{|v-Ed#vA7Fa(nkO1x$GG#WAqM^tUyM9F^N)>{7JD+3liVkAB7U-3Qr3ncS^ee<$q63_H}Gp`Rr3R<{rWUg-~6zTYb^YW ztqm@E*v{Q@3V<~KCAXKiWpOS@ca%cO1C@Sq7hg6vCpe0~qJNw+hFoEiOMJ^je|DSu z>um=S_#`poS2p1fLRR;NGD{uMC!?eHc>z%euA8~{wg$k&SKG3E^M2qVO0j;LC5q6U zWTtLuJ7H=&y>R+a3@|BtFsTVJ1qgk~So()uhXJO}aZXn9*}<3|mr;7ME}VX8CuN%B zgnWXFp*cHDByl_SBf^;AI&yCeE9*km zGbfYl26p(=KKcIhJ2HU6BNR(Qj&M$Jy3B*tqM=idX+0^8$slo^zT``*4Vk{{&Tk>;`@tiIN(j>zb=Fp z^KMkgK>qXeRaH7i99MZab-DR4bTk>iJ;P-Ov&vVSK4;3|7l-#b+V&<$t$B0e;cHDO z)RgBsAE^MON?LmxK4~LIjrv5#1|P(8(zkkk(SnLTH^ZzGs>pCyqkxj&-Ht`Z#osB= z0lSfDH&HkVS;G4bN9uHtvPo?|j!FuiBvLi`jj6(8W0UK@J2miA7iUVUganevkq?d^ z(1qUaFV3e!e1OkTCvbi28faDP_$EKhf$t27&0E^>;E=Fpd4|Y|&^*xC&vc>`<@MGd ztVLS`XU;=EIZ(JlGucWkruzYKfq~=aK_QWU%7{sUJR{qC55+zyKP(O6|%4QN` zt53PIcM7DEIFfB1_QUE@7xI0hAt*<8`*gBUA->puVmIlWGdjP`I6Ar=1hXkx+Ww#1 zfYjvEhQQk#?D~4I?VFwh^5(SCN$qz>j{(6u2Tpln^Zi+U9-CAmpCJE-0>KOXoH^!b z-yeXsUn2JT+zrMl3Qf*y+DXX!-mhQacNqAY3NJmM35N%Rk0(pd68-r3l^6Vv3BOg- z_t*aY1kWvexrIqk9bbiAcWj@FLcS2gqqzwt*w^@y}|HmB6jO!y*DU+ z{IZ9OHyKmhYuW`?gRr2Iygi!8OWm`iN3S(W@IaSn3`f6*;_hp`p*1EOP?(FB=&lR_ zyN&JcJ?$}g((2cds{`IB#L(e)FrYUJpgGvuE^Q{ilYPvnd6X z>a^fEJaiKnCiX1O%{xn$o)DI`hg6}@A1LL`yk}n#^@@{rkRCBFA#W3u6Z#rKaGeWy zcnsnRE`p5cOPfTb@&4s;)juA2>woN6iN=G}-_JKHYa^gCW<=~g4Z%;nQOo~giujyr zI`8&;2?g~Jecvu!a)t-;V{sI!-uU+5qZ7Tl%y_!%@7l(iH>6lB2<)ws0pqKpf@j$L z@t;MQh=h_2%ACvN`T9BpJ_L74+^*#T;jx*Bysc1_PjY80($hwMI&RWKw9$Y~A9|IU zbwH)}0(DqtIB|~Ye-Qk806u)B3e_U`iH4d1zh;Pj{Js4#Ia0!JL&hBy+(*<&F|W8O z4v$cQbhqu#Z>)~^&6wBJl-wLrUXZ+PWUv6<7P6K41UHm%l4)@|E|0%?9+rgs^o4&J z;rX9_FoVtj1L<-ap{p?VX|=se`19shwq}TX?zLbKqmvAgJIV6tb;;jg6tFiawq^H$ zu8W6iI?4P%|5QqzV7xp2c&9A8L*yN6)|M+@Er z(-_=ZOB~GGjUd56#C+BO23cU04m9G)_p@Uq`&U zEYN@1y*FBgs4L8;yl=+oL2Ou+R${a!8XUXi)Z8wKJ|Pxdd$p7ZUoPh=)!Yf#y|u!7 z{kaHU+;xyjl@LW*_p43U(#~SH-{z+YJ{<^T%omt5mw{<5(F*}|*0{O1n?Lo0G`<vz9puAF^~tW*exy8|h3&_?PB>ir}P* z9@cp)$kMgS0>gJD2WEFxh~bX+xx{IRTemdBKHBR-1Cw^hVIB)m7`9g*WVb=;2agUk z+FGD9x8u<-)sC=O*(s{jWCW(qSY4adwLegAWZ1b ztJ{2L=+r$F!mX?+GC&bYLf`NT)M>-x$OiStg6H7XKm-4)s|G|a{Asz_L|(}E_#=C-%@86!H@%+@y!yA)yEYain;V-@^g}^g^rj+g!!A}wCk6AbsgDefZi;vC|{??JtFX;nHp#9i;ab@jN z@IL$X&d&~a?3K;xkvx1A1!QKO$+(D|+$v80@7YE0_XV}}eJvTJImTAJc`hAC@11@M zM+qLo^?f~38c7i0zx~VFKAgx$@ub$$jv+YQO03$#B3%6k3G`U`VdCUH-#-1-Lv8$f?8YA+L72(%70CY@FDzB zPs|@Yyljf5M~$0K6M4FE8~R6lqkRf;&y;PA~vt zQSU&GWXg$Ppga?laKtqk`WS0I4F@M+Eyq^i(b^+n+U?#uh8=(a6FCNo6?Egy+FuZ9cMI0m#* zXR5%V>Zc@fPVQiy$G**16pIO)FJ4{94#IuyGEqJ?(Xh}Pv!U;l466Gd^OhF+A-S5V z+VGPUY%@{&PQo5Y9~mz()s{#+*U0 znKz2>VH*0c=T3C_VHgo?2oN2GtKj_gRuR=^x#oufK zCTbiFtCXpk=K8iEkb6J3`${xkHW#5Rr_n~L+7V4*;(iWKzGo)t?1pqM*WuiJq$BfI_^!WX=f(*ODcr!l@Os1xRu@`K<|{VEY5 zX*hYiBWr2V34c?i)z7(3cLx}TZ)B8M!)1~iS3B?=U=8j0&uL1qA#ENkHhhZU;wfL0 zvbRF%*T)$e{KW8Hly=SABwH|xX3yWD*M$@G{Gz=vt~hfoxr(A$8#zVv6~B4;fa335 z3JOb2yvQ#e|1ZfGk6thEuyL`42EFr-ljQtC@7)_K{k@JjsVw}-h0rat>mG5I6LSG> z8L!f|UUzV(VI6(n?TjK-4Uu{_rkL7%xO2~CJ6H*y)NwAC!V;?fQ$Iq@@ZW#!UbLBJ z;1$Uxzxhxej9=}qZd@Sx#<^OqCub!gJ9hM`Ad3y~<|h?fDXL-Y=BGl26e1tuMoB_~ zvmP9O#ZPuNQx7hZ_Xbm5GQqg31#U;SFCzW>SYJPl9O)@F5ErjQ8 z6;BEZh`|=?9_tU~2O&^FV)!Bp(ZVpo_ zIKFSk((wrmX1d(iVjv=YCMga&+TInw@*WTCxbK3XctEz!cpn!SOa>~or4U>cWyaNk zvuyB@d2{0+yEf=hAMq^-JB4EdVN01MiiF>JLQ~=a5BMyOZdl4+fU0e~G1^XEeC1po zICzl>n@{CU_Dh}t<$dSflMZtcyy))jTPII|)uYXIDP?I`_lYPt%O;N%J~v}E?kN)f z+a<>HIr@-%=UoLa-FX0o3nynk8)C94C3HTQgbcBeL5mta02ul-@zD?)FJIf`8&JUc zU6oGBlXkG$BQsih{t#+ADKd7N5PM_OP%YPCd7xvF*p4Z2hhW`3Oy0)&SZ=(zPsqy+ zIjCx0J)1Ux^9`BwG;WTN)~TMr>1c-Ej;4{kC$&P#_a!FWXoRzoVKpSFmT#fR_ z)v$gjS^>f33A!3JC9e#U_*>m~Sm9z@^svSr66p;c}4j_N>1OzB;$vxTUU!6U=Nx@VX|f2Y0)qTo;9O zm4Xwmzo=qvK(8sC*NFGq)nUt|22w>ZF*W;B zDsTrsRrSbzaJz>5ZTD*wcoQLg!|9Y|c@;bmj$27sjfA(km4V~k?zom>?h(|G2BLzL z0XMk_PN1Q`p;R~{WWTVerHG2c(Fb(w>~zM+s@CJStsjfrpF4RXi2UrEvX-?{*qMrmmuk%Ox`kjHgs5JbQ!6G3aIR;%iQ%5c&Pit6R!mu&?s>{v{I+7@iL1jM*QCH;1WMVxGu@kn*2WuZ}nnF)!AT z%hQLW>_N;Q^=+`Nu~txEE*M*G5%!BAAAIm9wQroru|D%X_3ptI3F4k<3TI1q1s?U& ze67#IVcWRlK=A{6LN_mX^nVnccQ}`C8^%RTC5lk?P9l4A*?aHJ*WP>YnOTvHBCAsU zkR+7iN=2n1q(pX!WTvd-ecpc^IJiCT`?=5SJU^#jYA8&3O5F%yGDe}@`MVy?I-yV_ zoAGJuXs}AKu3RU2gHQZYlFnmx#|*`J<^!L6At7(ECrZf`mcKggH_P%v{^!j-<~l+6 z^1LyZX{{|_!`^E#q`&P`N!o`B^BmC7KlZ+*vLw1ZX=ZU)$pWdF0~_}r#^Pnua(kDw z9CTlz%;Y)}17l(yGj~ikpuNumntxw&AHGTCoq}3je-nM@mSZp1 z^A3Ap#Y?xCbiOR`3K-K^XAXwGgSw?f*D??|QlB?$gka^s=(QrsEKs!DN{J3|2NnMv zL9NX!yd=)E&=YM1Wn5ObZ6O}UjyIEcHIZ=qLc8_${y230QB+a-H5{l^dWFD0e`8OB&x#3qDvvSNyNK)DzV2=|3z6J8&GS71+B!40~M9+SJ9Fz+ez-^0)8N zKyxLQgW;V@6t*_)2YuFixi3be6LRG53dyPf4x%Ko=)6%gcIFL?x$b`(PeW;n+N9+LzuK0=G*RKXGjZz$xa%3+vip$g_0t zaae>ardu^{?urT_)`3!|>Z1dkZsshOkPgMJ8V^bZE6 zrw>={obW>G+3E+?YM}1;nx@Lz9O_Hy1XwH>(L97^{b&I%*8OeEH(ZcJH?kS=Q)|{J zx;Nltxv&!SCX)YV93=YG<&C%KPnqDlfH7x0iz_NWIQ&JmK?x$G#GVc|djO}#hXkur z%2*@Mv!Bx58+&_vGfCP( zYuQ4(XpE8{z$&FU&U0jv)U)&DQLx5FCrqca3bf!Op@YLAgvW7&{r7 zOz&y|dLOsh7*!PT`tJAfSE8-3bbEG8uS_4>8hdxGQW!$YkKdx@E~Yq9#nkw|NE})9 zo8Gm`nZoGO#<|0fPZRHUPT>5>rd2Sc9=%DD)>(bA4)v-20ldjrMA3FA( zX+0A!1yq_RIYi#+V4<|;&1Gp(oDg`>(Ym7rH>^42ZT>rgmO6pkWhq*C_n=IVd7li( z&(WFXUeSQ7{QLYL?$<)W`Q1uQwSbzwwKoJBwBSoxcg}S7N%$|jz4?!mI{K46`?c={ zEf~Z#u5`+9LBmwIU_k{v(m!(HW2M{+mTv(B7k0^9 z>JyrQAoU~_o4GS2 z9N5-TMXC3-Zr_Sc!RJa#iuoNzP*UYxPwmvkURh~nDhXkD^GNF+!+Ac4=H~0=>Q}&! z?W%KO^K!tx?z~R9hv0_!uP=`-8{tky$FAC6qGic(F9oP=cVs>l!JAgaSyua zQt|E*?^WuyD_C}`^-e`q5*{PtO@Cf{89o{`o#}s@2F)YciTPuRpqSLSDnR5$XeOHpWi1E20cO?=1Tj0T2$q;-IFh>32ohMr6ym<}6LE!y6{gwJNf;UNS zz_}_Ig0Aj=5`Ihg!Qa6tEk`a7kUI9n#C6LW1CORlbuuSI&fuSi5$mQ<_1_0ivq^Vs z9rtc9i}wJBsJk}yv`!#DyP(B(h*`rMVuWH`BJh9(_U~@T27(QZdn_d$5`f^%s8R`@KRyNCvd<3s#SMP1hmI#>Wj&~$$Nd}XS6Msdlk_c`C25d|x z;si&Mg6*>;*lHOZu#fSDN1-nj_jMAz@CDXI&Yey;a>OY5e)?Gesj`q7Q8AQV*<_t; z%fRSUxrN`eR6(0>hcv&L0iVZ%-i*b&V?ao}WCB?Vw&;@uM7;}ut8vSA-n@ZeZ&{&i zNgaq;x2}JXnmmpIzfW(uOZoyW+hEm#LLfe@3EnG4Z~zO;3mMs~LqYF}9}8uyH){EHO|kuF z_@Md4d%+Ou+gS9%uqpc8!ssqZXuF^T#ET^sppLX;~-H1l#XC z_6u7#g4fnth3p!}1V_EJ;#!IkdcVG+w@K`~jGxVdc}o>RU4Hb9VV*SvYag%hsgXun zMapR(D;uP>&8c&;RRLwL_1@tBtUxjDaRS+HL-dNV_GE0f#h$|-mj*^mA$IOunYgPJ zk>94QS8z2#c^+xnv5&?mtk$e!&|nCy(O=r#0tw!;3YB-cnklN7HY5sO% zJLOej*MCNH$GE!Mf0MZ$sAOQpFxx+MF*K@>>T|okJXZvZ7M88L>dY~a^3wAqRb^Ps z9QJi+w+346GzViz4Ro3K;m~1afsk8cHtk~oK9rhuCawm+wYNUL(ajjO5`r$cGs$65 zL@f34Arqh;KIVA2_9TcJeP$_fGeWNFwurw$4ET&3Tg(MTyITJPiltT(yE_+hO)tf<)>wl`V z6)MQb&DC*$;Apf~9<{iQ@NY4BFi-L_dI+BEgZtaqRrjcbKj(KqyC{Ima)QXGl}zqL3~ z8Ufp$nWr2%>X^M+UNr1#g0Yj{_l@?OKzyz0E{SC`u-F5wGWV?Trq?Q^nu%{a+g?9|->crEzl;S;AjFNn^Zci0BQhU9-DVa2c1m8p)I*azOg-u~&b1 zvcQE^^3^?$EXYrDSd?@tz;}g~9#5?;K*nS8mhf~LR_&|HkR%a3CqIgQF*4cUBLSw; zfy7|EB@-TPCYK7gUnNBjpUQ_3*<_K?Vq=(ibdB``kvoZ+x%{7>PBJ`}sO|s99|Y6v zN*Slr(&3}X?R!%6j=(W<u>LHyh|1PzW~`jri{Zbm!x z0~aA<%59+fNhZ=tQ{`SR^TQODy(VYerEpIAGkWd|0=H_Frm<*Rqb-J!%qh1^xs0WyP3=$4}`fiGNT zImyx*G}ZO!E{{87V3?)aPu?(meE#w&XB~o%tEm{=m6!}K9%zq_EbF3S?lro&u0(ti z$GZ0>G3Q_s*iM%{7YWaY=oK5!Tdq|?8 zSbry|Wl1LyD<(*9VI={6bUAiR5j>(p<>sH{xl-|U#l>{mYr)u6y^+}Rg2-jb$~*y2 z6S&9Oc86Ol1z$?57<@h}g*|_bYCF{lUohC%*{>U6tIM;)juNrBC-RwqO^GF3Yvi2w z&i#L{HysnVy$8OreL9qQC^Ja9exJlKy~Bi6Z^ct zCGtf&mj92?lia4D zwMharg^j62s7b)P8BPAASr&{bMyr^Ai%FJU#^d1Vbs~;DKvPh#N0jJHd zqPeLx@)8$_6p&FX+%be-F`0tpBPWR-`G2WZ*HzJYuk7xy4|9s=rt84@?~iESy)|lcLM6Lv4=Fv)X;{De!`jgsaJzEpblW=-S>RFOIGPSr>cW z86b(rsV;n24KB1$%9(!Ggjl2dDeaU7c(>^i_J2~s;yc1mdRWY$S?=)Tt6$E5896%_ z=bR-P9~^M#)u+RVp=*AF1y=By#`KEn$KiG#d%f0IpUlvhS) zmhXIgu4#?@&O#e>1}2~=W!3M*WdkwiqFgR4o8SYJ*PodVnxUh4{Eb(^M!+!rM(%vM z8q}RBc}00O0^6A$3Jp(1faB8qQt*G5h(79__W>$pn6>q7DV042805$luQVi~Nu00Y z%ytN_F<+zQDm)9z2fmxlohk+9(yQ7xt^CnfwFc2%s$10QzP z?^~(QB>1{yjR&jqu#+;elyb)mp39X)9sTQt`;Q;iPMu8ykgjokz?Ox)Z7WS;FN#2f zgC~`(T^Vc!uN1{3g%*W}kWm0t#d@Cj^;pOXr7=1E9N+&7} z^S@>0=55=;!Sv3MsD_J>cfn^qKr$I^_>CRd1q+el+{);O(2Fp>kE_2yH3EX&RB5A$ zxmE*dq`-sQ13QWq&Qh-?BFz~mj>++GVCKHP;C?U<2F(@TsuAZ;55w32d5ScAuG2O2 zf)oUcVnXjKc#UARq>o`G(i7g2CQsNt^8y;>`#Fx?4*06;vhKfh1u)92Qf^g`K$oG5 zdxULlFf_>A=WAs&sMIW3GUf(CbT#wjPirNde5DZgY}N#hjJy;MeeVmR2E8nGU7E!C z;m%b#?Sq%QD)L{f_=9b6Vic_;3H3VY8?AOsadUh2%Au}YvtY)bnJgK%*51!K(K>_fqU!_B^N~ix#9SmH_PGF;JH)f|)HB^6_FZL-(d88tO!;rRLnnpcQW!iw zs46Z6m71>o=LVuN-%6~-BwG{vXR4Qp5Gc>6 z6!qI%Ver;0gZujrf4sk6=8Mu)Bx*M~^c1F(;DBZ4V#axY7^KayU1cM3yry;^2lokJ zg3O)o3`)`P?!wB4nVW9d#PTUz;&MDDTrlWS`w~y&jm{6b3C4r{rLP&sAQgqS;#cGR zg0Vb3o$t(W63jllHB9>82GvE|6g0{SxUX(>p8uLUc)oWoBArfv!ka$@GPUhdc;YU9 zWCf9r=^x{>Wpe|!{;BZzHxb|wA0;p0rcLtX2f&`BCvZusN`S2n490&h@3-qmvZ+vFN3-A4Ddp-&g4z0(9}ZrhzbutIJo_s%38<`;$GEVNy-c(I8#UJ#b4@RJ!NIyY4%V!{$46w zX~F<0<4jJ*ANEH9^2&A(U1JdUNt?4xu_vlN`f2s)t+4O;9ChUxZA70oCx>2J5Zg2M zaTgvaK53z=8pYztFY6Ct?8+#93VSBF2+!QW*op~LGAm|`)yaALm>s2y3hIo)Uj zys>rJG?@-qE*H$&y+!ms-yx-Un7PA9hz8|jH!2LKRXkC9#|uYJw!BjA)dtIFy=33G zyrD>2^&sQC16s1Dsyj2dA``dalkeMvPFPQtdCSBc)Mv|@fSlkVyFO%UO4y6^aj(!vc1J6$T7o+}M0|I1LN;BsCnEmB=x91L zW>aYchHoG6`v1_zwz~_*7#U5`JI#Uh9=jF9s_k01xmO*!%S064`4jom$+3s$ocF^p z{pT+MU+v+`vZ0ChUUf9lIu%T+A-KXqdHk0IbinI^(TPGWBcQ2z5h?dp3CAp5HqW3s za;>g4&^8=_*OwGxHy8jkm`XQxPAfu8?Pkak8 zo^X%$q}u3vcGSsiY$-o(gp0!ml?{%cffr?6{%==wVI)#}^a-CB8U~|4)CyRG4rChyYOM-1Z$My#=rGYQW!j$GmA2 zL9*<)0#Dx7AY&^W4&i&K^B?=X6>fKMmowLDn3My*g(edp%PnIwq`>DC( z#>@@Dr+&OG-OmNv&ha9zEp?H5mG}MS;L>*1md6ZbZ01nys8l{bT!<0+hCd!o5q)Po zbk}nTpM-Y!u-o^47ctcLuhYP{LSUpK>LOwiFuPbv?}2U}#)gx`bT`jJv{zyir+79D zbq>94RLI6ZO_FJAXL7+x`UtArZ~}&-!AJOr^J(QO-AlH^QrLa1>)9ItNrbnONnbG* zkId@)TQSdp+sFUrUU{8@kNv22v8Lr=|9a1XornyuTORxJc4md)>uO6Tzb6$Kq* zRt~;w<)b1ad=L~#08>Nxn<1UuP=l-OQdg1%9y+@*j#NZM+u z>g>&hU%YjB(GF2q_u-gP^=b(ECXFi_G&)1?PQ$@`t^eyyZ+B=3p4?iMuiqRv!wrAW z(-9$Ncp}MN;)Y=i_>RZ6*nE${H`~7KInSe!HtEh}rL8Z}SCpoF-Q@}!_q$d|(P2$F3`7r5q~*JW*fUnJ|Fyq1HAgfCUmU2`2s6fI*{vHB zKVqO_r{vPn{~QR8-OC=?NltKjt}>ZzuLoM`a`jUKZg`!7ZD4$k8`#Cf{`4$a0V!wu z!`TW`yx8f#%Fq-6k+&p7Khe>_V&CiYtr3y9ESkLmXVih=y++QXgfP&nV)o{FrH}Ux zdX0EEhoi2fj7{MG;$Ev=c7b9_+cKkZn_ z1}jJ&j!P{MBJyylCl_THeDTGEg@y*n?D1*!o&)?=~gu=84=GeIX2@pLXJ|ifco}l=<5(jnfeKW7OcfuPct-RQF}H zQbuxPF(L0F9}rf}FT3?h9G#PH`NU}ipz%$rF0xJ|pf#!0-=6k|s|-%g3CEmJK;-G} zcUOH-+rnsFQ^yCazgbPR^%6tL9%I4l7lJY8NaM8RxE+G$xtJ^FVbIyubiJoh7T$gR zC8+zG;O?GR%%}V#2U(6EO^(?GfYQe9JycrOIGDAp{a=+kstvjgw2qTtgdy$<*P;!O zYdt@pXzGloqYlzpUO$OXGbW1UiGA(!r{7@*X|<3oclv75v^`$kKC?fVSO<@f`^U@+ zbf7cafS@}%p{Qwe?|{w`*zLQ=xGTd6YGh`y&kA(QeiHM|MbuqZc7@4b zx(xkY1W&ixyZbGV3tDU>)?O911gx|p{mddbz-nBLw>VtTChg^3+AK>%8u`y8Di2t? zI`1_?%sF)}y6s#B-O#A^TdZ@pCM>jY84OQ2!cx5#$7-?#`u(2qTNE@z?rJIaSyx+d z^tjA%^(hAkxfFgrZD)fjTLqWiP-#Kh{;U&LmBd_+EM$#-&;ljj7liah=wWfQ?f#=8 zw!oHq*(GqFIAj{+yHp>w#eqX-tV(CUw$o?QUaH}k#M6VXnLBf&F^*yCUPQGt%*?CazB(xZXD>ymE_SLQXyUL6{NFu zTe7xJf)Lf7183<1AuGXt$U?jrolCo#KVCTp_wSl*)e7dpL9BW!CL4%9IXAwCTM_xs z`SN|I9y#JqUK5ooexdkRdZ?bcI2+^k_`dd;4kdgLSyA3EE@J)TqGq)QXXF-tlM!W` zfPEfZa^z+uH41U??{T+09#kyOK@^2@Qn+2Zf;g;7}eE++~0K zAixFgrqcg;IGuq8tjt3!x^aa6zjaM3$s3HdS-tlKpT%M-IicOZ!U?}lc-Cf7B4(td z&k0=-0qSwC$A=h#fa%Wzt@XVZ@ZOaxN8RLXLA0{6r!(Hok{zes4rc!1fchhU#( z2Ei$kU2ED1Lleb+UDrZVfX?n>{F}Bg$S~pT4jhU^zOPHBPlLko>EPdRo4-at61FCZ zYny`zMZwoz@hEgH9$|WFU=Kx_2E9&3A#jOuOHd}#0I8W?KW5;J!bb`&kvrETz@k}E zlrmih?)rN+8JEUl!|bOs+CygW{d2Gt8YV;cK|cBAH5J0IJ=DO-9FM(kE^bXe55|EG zlS0v3!Em}`J!_*Q3bOVbp^&)Z1c$z+eY{EdT@A`5f=%3m@Xd$r6IX9)L+IgimDk>R zf^U7~y}gk{Z%C-$lb6TM@NGC(^dJ`rRopG!Zv|?DckoDw=JPWs<5n(rs6-nR4o;ny zWpIX8GdCYgLoqN}y8ie+F+V=Ik)0ngDhO2q=Y710+=OgZkP*XkXX3tm_+*K9I0}EN zJt5lR1D(FD`@$WPfRz*!PDAiy?GG&7nNW>EGg>C4+-M8PxUT9wz7h@>3PtEzPzINB z2WA(%bcwvJ*}24D*6>k}^=#ZvTm0NHy{nPX%MP#j+~M&C;mdNicE)XrRHcUb71#jEyTF+7iV6fiF7Zb%qE@0xS#H+v%f-kZ$ ze%Rj%?s!?Gv1kTkMw<;a<(3{s>du~7nfC(ASnu62`;?LATNpEcItkZ5^$bqrlVG4L z@zI!#4K$osOuBT<39p1Ho>!#%e?CR`QOgYr;^TDoA8(l;$G)sNw*nRXxqH6orjjvi zioGi%Gu1|sztK8>>@_fReZTpa7HcBM8h2XWQW?kgr_UOTIbq|qeX>>T!FM5))zF1 z8g=-C(Y4-<%SZHKnSy$xVw9NkT2fBE3>AZD8ij%waiZsi&q_m>&>x*hH+g=0I$}cW zKt3}s2_Vj9k#C9t`xj0*(eM!ccx^6oV+uCF7Uf65(Bue?mn=A?B;7H4B<&Tyura!I zQ~tI+?FF~#JQJyr0_BHfb>EM;p{tvwhBSpHr0gb1-O6_avqqzG@}E{{5NE-lvs)9B ze@?kmXOe)gNZsnA$$31Diuojw zN4~;OI{V2MJP1?9TDkzC`@Y(0nKnhO*|l1-VM%DT(STDbR6;W|CF z7-;guM6)jHfrq+5&T5b;{%a`VZWPc&(d@`i*3ayK^C91xNOgd`!`Sbq>wujyF^5K* zh44mD-=T$zHjw6eb-N{smEeZSYaJ)vb9amwvP!f?Kt1FK^Q#68u;1TQz@@H$5h{rz zNvB1TS={O2bsiOv(dE3~Rl$OcVLpmlj6^nB@9#buSl{ygER~_FQv_8fLv#g=Ht8;(9BJ{r3VY4hH1SF5w5_gt834m{5T2A zA1M1AeQXFn=(JHGITt?9m7nS#ut$r1um9v2p8~_5a}q}k?LjO$Q6Wn8G$wb~kdE)Q z!uZiS&2$Sf_#@V+HrHhc7KS{#NzuZ1`NGcae`=Drpc71(u7zOU=BbIGmn5-{pX=cb zFEUpg-u60R0CI(yD^!wGidGaZJ4-8skL?$=G*i?G7=9CE9F=MWZ4C)$@5+dw?&q1a zm&g+#A=hR-cP1D(pFiKzp_Y!Xv*KzmQ^jDA#j)zQ{>j+Wd5E@jPZCI1JQ=O)3x(89 z`D4e50*QX}8FC)ARA`RvIrlE84AKHcmvxB#HoJq*$R&vVv0naVQd(Ui3VJoDvFQ85 z!7=-J5R1TKiVc0Af9IgXr*KQ)PDc%%f;$woPKq@OI9%$u#PJ7DaBccV%Rv=G3|k$#&f3}&c)&r z0Xa$LLn$E5XCeBE;M`JuT=8yaaRzd#CFSj*G-UqzIxZ?U5t%sC#W$BS;FraLnltn9 z@c8B$p*_2U#22vUABn(!``n$IZ~5U6Q!GvWs3njEbGq$484u4g4!t~;9R@NFoL{gJ z`b}kt_Q;VbcMPAM>1Ek6!n}XBl%;ztaLrhfjV80B%ma_KR0?WgqR;y-Am6S`ZRqGw8c#O;_2HA=0pW6 zGuN|r#FB0h!8!QKOJqBo;U!N1pgg!VxA>Kf72qn+YHaJk$+iM)WWrv zvf`F_3ou#cp~Vb#xRN07>?64avQwDYcrWn5EteF{C2bQz$KLBpIcb31MN}QlrYnke zX=RyOn}j~A!`?sOr-KSo6us)i{Z3*z@AofSAMgv}EIB6N3xBg0%(nK2Ai0299J`Gx z4(*7}{G<*C{zUzp8Cq*-V*Iy#ESli{9%3~XG}c4yy=1{ZjDvx`^6wD6Cc)#oK6p#& zFwtLTUU@I%yA|A<<$mgCM)Z0zNV2E*Iw9$uLA3r217M=KpU6Vw9>w_?+Al3Q;ZfPv z2LZuKxOcihV6ol}c-Pq0(ar?jzdY0O$?-#Vaw5zN|;lkm!w3ku?VZ3y7dA2`JO(VDDc9W#+%A@8RU3MR=4S&x;MPsuI%eQ zZ;WYFG*fRV2_J4n?o*vTHgI%E?5F9NJy=~-6f(E5MV>^rPGeC$y#A^Umn&>QKgcO# zVvP$q+`>62e;eb?i|IAAdM5C@|MtS)VR;ZtubZyRx5tAw8pEglvcv5omtW5FIzjBq zW1^o{RdGw`Z{)->kt=MIIR5R6HjG&texB?y1@otjRVQpUQK|d-gT_)F>>OREQ#daR zbuJQf67`B;e0=}tIk){N&Hlo=@6~Giw|h;ApGHpMlCb=kx1$KA+xYt0xe&P#`NGC$ zJK{wCoJR1lx+dz&L1B+FJGN%cSUT_31O|$)>7g3DSU!98*Qs_j6i@!heZNr&_6oQh zt8P(-5C8s@vmVjGtwzCFsx2{mXn&PdM&vq`8HHDZe=RH02DxcX_Lw6Nz4|tu76NC3 z#Ha&8maru8?0_DHJc=})PRemGLx!9iyoVo20;S!a2~lZX7?Pr>`ImJ9cMm!=eUVZ? zVNsdNXeoX?(6o@T&ul*)P_+Ge*jyP3qg(@p2c=*nafyF9Lkp)0N;^Z z5Qb!QHTqvD!TnRk$;pq6u#;EHcA!BTsSm(l(x5&t@M<>?kFbD36ZLh8qpBER#SwFr zOAJD;?4~&pAONCEM;_DCYhz%Xw7mSe`HkRop%3vC$d#U_;5rkBq>W_-vI4cNoX$W32ce77M0@>n~tYr9LXT{ zu2kjMjZ83$YgS)46p61hShn8~^AfgyoHv{1qk+Y!i|zPq4tyA~95S1Z0;BQ8sP|fD zv69w4QOYJ7CG1}~R~&W0@=C6NTiY(+7kaAwi|u*5WYF@bkTM%9zc+mRkm(C6?|1C= z8$zIWNP}BxZxZreKi|vx)(-4E1FKcv%K&YwRqA(Q-qio=fM?Ln5Fn$uF5~hf5MyaC zGOlKY;vT79!6Q0}z%5(a8`R?sN3ZRi_X{wXdC(>c8rQ=HLS_?g3+fYFGBqk;E?8>u2fnt{CX_& zg4_W!SpHMRPiq~8DaSHv4PrddR4bxgQ#6#wfiO`vQu#qm_bj5P#ylwbK*R)pBZr+Ya@L2 zdKYi`s+Wbq{7oiS`Z^MPPbs&KEsVste^XC3ulpj8W5QcE#6=*5 ze`L|A-xCIm>6AsI0P+jAEsqmlujRFB@~lJxi}QEWREj#mf0cDIzit_VE>{NSFGgnk z@ZT$*L@Of{Wg8RP=9NZ|UA}I;YqkVuJ#zY!o&^2~+pjQEO@g<5lhXIXj-W^B(fNvH zca%i510 zf4FH5jgbNUoW$n|J1QpSaXF!19A%5-q$$B|PH!B!V+J-C9aibp?BH0gqUZ51rnoyl z^Gy<`DHiI;4L|v12(J%R)XP8Mg{=|oC~FCV>$(5)c`p+q80Na}bTdr|r&m*5IXGRA zjWy*^tbi^YFxQnD(ej0Ey}xf(j9t-CZREEg;fvjDc~a}#?+@D@(@rCVZu9s-)A!q< zp*VOVmnN>t6aR~6cNV`M4*G$wYVO-Q!Mz?j_KO{%IP~@wsk%uR-EEmmxD!I5v;E8O zwq_apqQX=E!ZR4z+iKr5hM0nbDtWKCv_F)J4SoHQVvfcAL1r601doo*(o7=J82EL? zZ*I*SK*&C~XGh|+F?F-8(b`!CX2~qm=zd7UR27zVds?8w({s^YdBl8YHvR~ozCCoN zJN$}Tx5A9;Gi&^RZIOvK|8R60(W~H78Mf<+5!~h7V2-})jgM>;Ha_dmDf(m?9r3F0 zfe+jd#;&>Q;4!w|dA~3(Bm${FvGo2a(01MyXWFmT zTFsh4C%#VSi_wHHrt`8IrWTmQa)Zu1f)~`nb1##kO<+pwxv$R`9ek(U$ekIbi3ya> zmqm0r7p8R+J)-_H|Q5M_CYz*-m=m| zOfX^aK2pev0j}rlIpdK;gU)sViQ6_zxX^!{%3hTReru5@$<)$dfL0WJYO(Z&hle|Ck|rt*I#5MLWM-I;jL?Okte5 z9kYsW7S@04wL6MmzLEd=M9hP`Uh{LEd@PNAn<_h{90b2S{%w?h>QheKF+ zf1rxH0=7NU=U~1ag^we$YqU+H!8A)qm*sdNc)YR88~&VvHEzl!J$EC(tz-Al%YUx$ zNcGJee@qNk4wpth&JIV3wPG!^+H}xWlU_`APeaR?4}6Z%;lS$sK7HoR1t^=%Rt$2E zg2ajsr`M!YP$ag@y8H537XV2U3R^|B;mB(IN$jw2EH)pxn^T?{h`wfA50`L~d&ydNvs5Ws5y7oexFwMOv>|=Qxbp7xLD3#R1ON ztF!EijD@zd8z=I9IYRXxJ0YioNw}~svu3+u2%UefitEv(fySq`4yq?Mc!~ZfQ~+{Q{wvic8w{)D>Q(%BzGK6+jqW^=zlu=+iBnK zhwkutmwnG@mmlO0b3U%LGshUWr*mC)&S-7+`9e*#Gd47&=E_gFz}5Uh+FuV`p#QzR z^6!J5C>8LERhG&F-&IGNQOi470T8ga?@N0gz5NQMYG-}IQYti_usS~+Ql%o8d$o( z$(1zcZ`oGJomv_i;qHp0aiMQy%Nk&3L0`4mO6c)!TA?)+Oa!l#q#q@&2RZ&Ht4MAt z$j=t`IJmqpPL-KsOf4Bs0^|68zugvon7LN;o6e8CK>qdeX@ zBzpqgJNAQT0{G!^l)3V(l|C-{QL=?H=>V_fVacAk9Yvks&T_9QS(tk2!uofE2GmY# zIT?-UfeMHJ#U2g?Obd-I?~c{MkkUsx!!C-r&!yok^Q0|Yy?QpKE|~=6Q%_y>g58k4 zm2)Yjkc4?h2h1hk+rdqdqv|*0oWaWeMo1c=yEx2^MtSk5;?YsA$8!blAp7aAO~y1G z23|Im%r$hwPwUrqJUtBYaj)TK^P(#R33}BI*f@jmuGq(a{GD)OX6LW4pFOrtfAn4J zas*k@6TUa;8c=OW#-f*OhaGLyCK1H{tqPl$Aa|}23>k)b{_L>E7v8)^>BXFQ;MI=W z3vp-2*`es5u-C?GXY=w|P6gn9&6F)QVUFOiAU*fNCJ?$dM~UxittrO^>DU)$E!*$wAr+i(A`R3}zX9Z^wpbK$5J$hdOw>_wy*E%Rdsm3vLk&m)Cqy1NP zZcP~tvY)Uscv`?Q#_IT!AJk#*E^#A)`;M5GPWsB+Es1JQ%d~MSByhZ$FmSD--S%iP>>{PJuQ&PRkyd0#a7-ZQ@j4MvQqCXyzCV~ea9$jp)R)z}dJYAg# zE;ymmOBSQ7g&uc)7;TPsx3^Fku~hkL!D*wi&9Tm1DBIzuAey6w`OF+^s#NSSdu2_+ z^ciuFd~$ZDj-Chq+^qa`TSx-wE#6gfl}o^c+5N;oF+TXTy*TC}FNYM{%2F=J58)>Y z*|_PpG1X+Q`3$5}X*-exk;eUJs_LI@B!wNC3OuF_AV6Bh-bum|0dOY~ZzAUKMgqx08S4>jFyf(L)YLlCsBnCj1_b`=+D`PKuiYEzcx3CTw)}?dr9_OtLk> z9)fr9;uZN5UV_hCtf1T0vLKBs6fKq0srmTkzOuk?fpkotIU%fW90z9~Nv`fOaRwzC zMX$r7#QlaW$1h%?7{$z0*nG4Sv76&cl4JULF!We{7W6&}kNFncRF1=tq`qmdF1TXZP73<)+gsh{PG9fVS_ut-_+2FpQxf`>*eGJo=s%_%bO{1VJaOZAP9MppD0s8`?r~7@Z$1 zUOhnqu57bJ`ffL9$nz?^CY%J@+Yi{Ul!fBCGbGY0j|j~FEq;qiC>0jn)W&(mLtu)x z=Yw)yIKHx}A~`pvp`!Thi!pq@P{=(cL3cPFE%F%~Ffi>mR{fE5qmMFoak~st~E@Pt@ z;VWxSs`0x3o0JY6n)sf(y@Lt9iTB;J<5w%0IpYLX*CuO1}m1o?7>G#yH&*E2MV*S%)}* zL%i0HR24H=IN;6o^0gaQ@F~e2-Thfn$3rzgtu+u-Y+p=_@`<9tSN`l5h6b2gv^q~G z$^{>)veQ&S(VQMyZT)amV&>3^AGs<3xC_gNp{JZ9Hy(=G~`jdblANj7-Sq)MOC*$Fov zQEvYx{H?D;OG(844iua^XH7-rh9yagQ{}xX$SD4RSCiixcID^f|0MKR{^Z|Pe5h{F0#YyOwG&R;yW+(8Tp{v4vg6pd`w&XE(-2}Y3E1zETcL&LZHIqVe z64w5BH?=73iEPuV-1e<5pzfr9TT;&hyqkWh#%XvW^~#55HI1J5J?W;t4Tn3pb{`n| zr{E2BG<_c93|?q>?n>xLsV5H07P;?X@q}}J-!^!vUEunH*h`BpSNupis=T79hYorV zH`~NXU}fmW^SF9HI0imG^|g(J2WrFvVn~*dlw`!7y+rs#cDsI*{^^D_!YS{HMs=}T z{B)gsq6gS~q3q9D*20dz%j3)J9;mbB)RVaA24}pz1-?+bg3lDAQn0l@_8IoZTM+B8 z$Kv)e@2y}E*xTOE`c@PAv+3dmc86ghho2|KcN*xD^pskBMCc0ko1=!pmS~>PnG+-& zg8!rFJp8eK+b~Ro>{T+eclKVFz4zXG@4d3O?1mMkjLZ^|6qgjKXi6$=qtYaPQS^S_ z|A3FjbKm!Mo#%0c(B1j^ACVh!Enze8nv8;z*YCb~T;`9L1lY4!J3}zq$@2E_dp|HQ z6MuPr&Kp$D58wZy>5WH{(t`H768!9(Ki^rbouS4jp#zHB zTEaperr$41B2WG)o*ZQ<;QoGMWKP5e^5i0P2G(S7B_OtKoB013JU3`Tk*r4azRw1} z-{%LvX+2H*R85fc@p^Khn=hU||5Eh>4dLgw>%{dghq#|snMnFBI^gBxxGwf`M?5ni z-v8}6@owuDT6a2b4wu?KnACPz;{7EEw3z#7e|`#&qW8kcrob@pQxoZ zp{NSi>Ka)5t9AM4sude?@9U3xJ;3ml59VI=eVp~w1N12!IeCU3H81DngP0*Y|951C z_8BMS&DQ^9P%waNEcWlaq#2QN!Pmz-!2l&hW8^-1Fo5TBt+%teF$5V&ehGQIuC?!S z`_V^xbWk9h#Z!0r&L+PNTvJsZ@mMzw-)GSj8>?V8ppk9R6OVb|NVKD4gSVqa_q|L0D?A6nu_M%6TrBjh`7L1@AlALkMYjZ`J!4c%01o z^-kIekk@L^pc~+WLu^;x?G%@Tf^*ItK87IJw>Rd5f=4ANA5SaLWhp}23m$)VKPcg1 zhc)+%O*uFUT*!Rr9f-SQFAR5PvvGq{RqDfYFF5EgSx8$`07on;Y=#O;k!8Q_-}&TI zn5-b*`;Xwdt0{cg4&o^U;jA~p8bcx2nHy6eqM88Q9mjMBuNS~zExnW&S13?DU80IP zpMzJ~KVG=0DFd2)tADHi68VbK=aR|EN$4GrLdiItgZ51EY@2Ga5HS?=@*u&Beo1#4 zCvsw7$v|bpXC?sS|Fh(?txUsH$4XOHq9sx7=s08HPa<~~D?3GhHVRxT7CbN_5Qnn3 z;uq3W@ISi&<@@Skz$qZ{8M@DRn#X241?=RyL*V<-ZhIce`*;N0=ZtVq(r!N zz2ahNfFF3JJLQgS7GTb}?tE-Kk+Cn0j5+$ zFj??L>@yZWN0=%*NpxV?;??lXP-55FS zAMX(JN?#ee3E3Dld3xLZyS6>B;>`Os{|NA@_-5~+Ba3^#RSh5h9*RF#K1sCln1FY& zRGIFuH}O3gnr2}~3WZd$&t5AlA(O_ux2v!fJWXxapy{+m8IQ0>Aft#Dc~F>C=LC-r z)Jv9YnuA}j$6B+HJ*v4(*;;Y?;$2IN))5(57*Q!ho7rdxSGY8Ed&z_NJgO&&<@lrW z1YxceaKm2=bj%q#uAsHn+8FsR3~a4~bk7i;hR^TJ_&ydp;peFA`NBmX(2-6*uSw+f zR^tDJ{w9ZD12tnwc#S>0a?jSsn2>t;P9|O7eDb{ySO&A!om}bk7pX^%|pGR=DkqhhL5N|MQ8Zz#+s_ z&%cX0Xsw7$J3YDn{Oa)X;@dF0co}%ZAEBo3ofcx7c@Dm~0~o>UDxrQt26NZW4T7x! zyePai8t<(JS$D6$yz$W-H@^LC)1%hFXJ?bQqxfyWsp--vvlBmjh!&k&q_)HVruC%H z?O}oRi&V?XZPp-R*L^4bn=qQLJ(w!KYmP5=-|wFjk%JP^UX{lEgeR0WUxEC*9JXs* zFdd{;L=T>#{x4iifF#{&%W=Q7s2C=h9!tx>rVqdV6-HhN+ca(ew5*F%7o=%>j_=10 z+OMD+P2imriKR~Tzfnov=<9z7e^k?JFN&lzKcdDgH6iKrwyB7|0$e%#?a(y=d2CkO)A!(%GX8w| zQ7Q2|8_ZY>PyXqW0#;Ky<^y`9knroY)1M7$JbP71Io)(?v?rrj(@cQiXNnmWWe{b+nTOO=P{*VSL} z{HTfl9cdoe;xC1dsx6Cxp&76)&9wF((Q8WEVxIZM6@@pX{@#%ya?%CLWujcngb!R; z|L~nJPH-*Q+eCLD5C1L&)g-)*1fe;b6C}LV5D~R#Fg_VV^jab$xHMw$UuW}51zjf4 zdaYjUG%g0sH!ID~Mls+&y%qOiq6oi*YF#Rh^heq^=}G>B0dS*1HF3T^5i&ytQ%s0` z1^1^}73QWm+^^cv_UTI@{;hv56n5GL9}D_Sj|&E1oskF6=X>e6-)_=BbvgwYeGHyH zqY8!RRR`q0HKpLX*(OzGVJOns=4xo1N&y-k!|?B4j9~MeuY=p~3`~4KJ7(migfBu- z@FI~%r;2~5Qk7u`ejn*|zI6HF%o3NxF9J;1`8nP9YOoQo#7G)&-S)wYG#wT&j}<;A_F12Q{Gc`t$iiK|uIPhtIY1M|By!gw20BUpQ|3IKf$C4sv(I^F z5ciVQ7g}{OP{wz1eJ5C=jWP*iyILi&pO4vgtZM~S9n|l88i-?xWx}hM}aH$jh~U5EHd@ z0lK)&o(tnHs2)jA;Y#F2v{nl~n`{vLE9D|X@?gS?SGer-)Hnk7()FGzsvz=;Bo%Y! z6cO+(Zu+MYA1`SA8zLWei9kg+PtyB0weY)}ml8cW@!sn_<|bZC^h6C6c6UUgu<~SY zVvwLdj3*WhXYT`K0*!uvtGGOxJngd%%$JMLPS*6Tjcod+&4yNmDFYa^5Nw zcEtzp{Lc1^dPB1M?Qh~GwvebfDcNNogkf>rrrXn&m>XmeapPhzJW5uq418h$ru*vT zxhefIJ@EnadZ#eVm7eAjmG*^$zEL4>1XxsGFiijq$g~Cw-xT@9=Fm8y3)Oq9Z@J9@glY)8 zj&}LMt`g5JD=w)7gPi2#SJfA74^lF zUm5A>jwoWb%9-xrEf=sC)hREEQH6yp_rZUxHn`yxfBvYD2HrN#`^v|n2RoSux*lB9 zhk`K6wmZRUc)LPyZ^IQ66us)6-6<~&axeD{-3D`@m!2~l;}^n}-8HtYPD`Yv8dq(+ zr3N|LGp>C+*1&$c`Ykn!0dBvgryCfs!iN_b1oJ#Cpr`!n-&^Bm@M!$>#Em+0{AuNN z+B;nb>5`_p4oG<_RtK|){gcK*cbS$0 zDu0uHDJ@QlHC81#cL)y1e~bTQF55BUtg1z7ca9Anw&Gp+X~7T7TPEF6)D{F6@A#{| zv-?naKI+kXbwkuT5YH`W_hZyks%+nWMOFAAb(u>0As^JQ*K>vGh~v2w%`yjGbR4=7J)^7+11AJD#E15xP0M?J--kq= z*PN+`T2K{sv!a%dis%D(h=;Qsw-J)f4o^9*#}Iv&(VU}M&M1GqktL1D)0UXXT#ZP~ z!9gF_FT2G1!at=%@v?9ZG(F-9oH30>`)emR$GDH7JiBUqCzU=X=!{!#-;M`YjVgnM z;iDMvUA6U~?@cKj54EHnYt7n z1~s0mJstvOQ#%h2(S#vY+SlOcafz65M$M-7g&|H%NE}wx%)!eFbSld6Ht>ArRT!7O zDfH|aqrAG}0y)9`SN%^$ps)JlwxFIwe8*(=weglMyjxMz-X~9Z{Du_6ENLSlT1fc} zg>MkVeYy6zt2r9)OKv`3`5FlNd&N&gpHG1Ok6#DqZpNU}rO@^RUBo=+744eH*)SNP z*yeBb_JpmQ<6R_oQ}MK9Gkd<9HTK7bGRwOA5j+Xqn5Osum|i=0$JR3dYGzKlA9MD> zue67{`@+J|r$c%1-I60Xj>LIz2D(CZqQuW+V?T(05Y5m(WrmT*|Ev7-RuU8PDM}6r z2Z2WZa8+!JGx*1I(mYqOzyUI*=U(%=1b-)y*Roz3+|x65MkKuO(rri5tB)dqX+M|K z_LMq|JyO`3zZiph`{BQ|4qM!1Dq@VDO@x0kE9NZv1Ych@Uof#U4xQ*&W-1-*@tS_2 zt@KtP4DkCIxZPgW>b+XC_Iy+eB%{yWxs<36Y(Mv$Y#|lFS7zcLQh6-U^y-GT&Nbrw zaeDQ=@xd_QW_ocW)msmdEao9;vo}KY&7-?pHsB%ud(%x!23~|RILHaO0F9XNKl)a} zqoZ^yo-dLUF4ULj>J$AQ>a*YHH%f@P)2C#KmmWTtJu#XwpUsM|-5(rt?F)mSq5l>K z<ey)KRjJP5vlj-Q2NlYJk(ECa<<=J)q&a**O|XefXaC%5?LSFAni4u3fxlLwJY! zoW$upp(TE*qLAq8KQMT5U#8j&w?FI|`mfdt7y4HcwbS`99Oz_aSKT1X{@x{*Wf_RQ z$??WN#}}zHU5~O26C4Kp>Kpr7yg`7zf|ik40CkMrPb}AYA$j>?(hd$a{8py5q>reG!4M!1eVx(|I$+W(4>@& z7x%qn@^qFr1f?Uy&HRrpXn82KXHywq-^qmVWVFKa;|e8DxecLP@LTfJJ&qtt^`ois zvKa=aoH=-R${oEr7RaYItiYtOqBEz)6E29KSNP&ijhs)n_O1XSZcPdB_UxA zr7elS*FN&Xd%DG-=_m_~Z`rk}7Uf0~9h;^mH}q(mnNCfEU?_lu2MqIjdpd1Vs0|q8lo)ozf)y#u&G7RHiZdc+!&UCxyt9(>XQ+&>09tkO- zr?qBEMbWEu?T&hCCf0YYnbXST!6s*!*yc_oEEkokSpD(Gp(Zzr1(_^3lpc5~qAD1) z^ww|F3-H393bvzbB5}BvbzVnxB^ONSmOq|1^9JSrT<&{VwebdWWI@M7xyyd^djg!}BtUy<(h$A?L;SjCP8!e-O=6OB_@@P>_gdZ#}Y@0IRn zZ~yFzTJ>+8=AcX(>*cxKs%3NEZdUsH?;qzq|S!CJoXwtibPyJ=;7Q^6@)dJ zy8&1Jcz|iVVyGf9Z{pR_knw0rM1_&VHZI0V;HrM=b*HE`T-k9QsQVX&aZ^{$9aD?P9koHBLqLIst2fO2Vv~wNU0IQ-9JG6aI3<^6tWLH zEOqTQz#lq)20k=7qRRbDFz1r=_8%!P_OM-_<~^;AFi)-dq}~)# zj_7D*x)@*&^*2Uh@&%#K?<5Tq{4ZL6x4aw5qUhLg>0O1r4>B?69clX@3A7_K9@NBK zk*(=5|C1Mb@U@XD7yL_-x4`8GOnTlROf;c>SNEAzxm?vs7AW+&s(GNcQ_e#{k`GiGwYVOdmSJy z_R7nLnjWY}b6hWr!~t`kB%gF2a)qO@l+7xQ7C^5tpBfP+iw8FH(dOEUmg^gVE>hRS zc=TMOyy#tJ*tgXia6L+e$n|@uQWTQa3C47+;f^p%QL;n*Mj5ntHdF8R zSmWnmX)*&cBW!zZedV}^64=HGX*pLKz%MdcH8B%_&=dR4+f_MXoQ~B(i;O<5)_o;3 zrFL*vR9VB}ygoe7vERBiu8o&}U1o|nWQ>;Nm{5x-TI0?^AuK$GpV1%A~1RdHQ27^>4yX0N3l0?)3&4(I(TvUOq6XRJ0C}am2;c`P_0T`~Dcbhb1}t z$J(e*xRZ6>m_I03>%L^YtAVjndmjB`^}_?Q-xpWo^g%811?9d~FAzMtEOSfLz737?6KkHD2a2v5rllE$}-<{hUsMiHOhU~m~+rQCb!%L zeaRlGRXwtYFzw&esyCeBsm5Qru-A^rqqY9V{iQ9^-xWG}-p&zDFaG7U+cko*Z~NZc z@Y^Hh3(o7LhDro)V^lJB$^w|EXSPVU`H`h|xTo!hI&$u)gn5Xo!?{$+{lW6TMz@yV zF?ToV;IW-E;-n0RL1v(0h4wGNx+3*`-Ew6N9b=uk>MoCp#}5blttvoy`_QGFO?KFA z;rLX3OB7=>OBMTP55NnDuhB0%e~)hO5iiWVCyn>piw)04aD$4_OSkoxa`4mShjhYE zE@Yo)-*q`Ai*naLK06s#gyS9|yxws{o?6QIjX#lxh{!GBeSbI^`dqc$PbDYdYM1Mk z>A^UtrkepL)H+V-8V=5n4u{Pr#efmlkim;5iEw-H zc;?cPX!uWx-^#V}I6k?te_T&57b@-e^oognuC?J~d)|gHC_7D|(nR!lokT1QEiNh} z^VO`Dys-dyn?cDNf5Qb7{AX0H_XD^Ttoq&TBzh|S4}U!wbAqDEI{&IzRhVqn+)>#L z!Id|s1ezDr;fR6QQ2!F~K1u z^mY^o(3$p4SqH)40ll&r;TU3%{48!o+Z?Z4Fz2RVA$(pV)<ZR)hjs04WIl} zYwS5paD{~*8~}k3yz}?0wa;1_mK24^vNU-ii&d$h|0KaXo;afWBh3K+qYQY|AZCY8 zPKB=sUX_E}g+^b+101kvRcgRm$OfZ@Mf7h78^hdLXOe?y`Vf3Ec%#{w;GsPU>uV(X zSFVP4zdF3}2gd^+7xps4n@3oK*vYnqX;Af76j6(}+k}U+k?&{w` z^7&x&UOUmI7GVK=PHB~8Lh%qJq;k2o-w&U$Y;%aKg&?b$MFG845U5YZ>s>K0Am(Io z4M!J!P`r_8V$;Y8DyDwT-RQFh_bBg)vqUeL<`-!Y-{@hWZVvQb*zXHee=k@TH+$kY zs+{n@&VgtfT^&5C;sB}~uFG{!#Jzn`T0bGf8U=m7^-%Ep;HQ0OXw&QLv9CbqU74mE zagH51DSS{C2DmQQRsZwBmYq5Ww`?0!Uk^Aq-7X9)SDhr+sQh4W7Mm33=mvL*2z90*IeG!6n&ky6Vug?;%3K^o~7<11}X(cFTRWo+h^nl7v!I#Tp z5>Qeu`$;L-11IoEw@;;|z3&9v8_ zSDV69+uXQ@Uv_Xo$NNOOs1forb@I|lnWOdUqV`m)K&5Z#a4afPk5raH`M|wXoFqlH|(I| z_K5>s6$F1-FYLa`um^6li1eJeXoeg7X1gQq-cYQ4m~HI5D*SwmQ3>C@@i=$JnN}Vy zf%2gT42yUEXcOJivL7dRVY}gtlcr3aC(FcPsHN-Q?k!@Uw3+|6@~j$Carj%_ zwe-RVk{fxMnFb)tu^SRm;|hEiTQnZz18NQC={WOR;@ravDdiI)z{+=rYR{w=Z2tag z*R=aktHp7JS~^tvEZBhv;Xn#Tve=W&44?o{0Hf3Ae@ z=olTZj4(W`*Vx+M=mkbGdd=2l+IaUyaKFI;l=6_ZaPJZz^sIx|kVf$Bs^mu#jz zz7o@JVlg1NpKqJaT9!KiYZSG^2_|cZ?OU^I`)7~OQjQLB3F;8Mq|2vAKur^LGTkDk^B{=1KuO#Io)et$@5G!2^8G>^$F&VCZ89-5%DL?tM9Lz5HT|Z?ahy8BH?%jGUgl^9j`+7f7 z;yCkmMwc`X-2G&FTZKXu9=IM(A_nB69kyrdQXlGL_Ve#_l~oClFrTi+Ma*xnAPoQd z8U?*yWrL#>!_X#U{qm?sATX@3ZnY&=!lmCPi~nkUfq&3dF26YgZ|z+C@QuO%2Dj*I z4;96MBGcGb1!oi_Wbf|V9~S{exz9=$g0t{%qf{t)djf2+B)6S=Pn=_Fp^uJN5gbKud7;58V87u2=`sXrAX&vZSKPF^>5|1}P|HG2dAb5f8o#+(8=6o%;#P?wO>;Vrj zk0PxRCpb+diH64qO(XG|Faw7Iaqr1<9FEht83CaMVyiDW`S6|R%?_90Ky+f8Rlh{! z*YraRJXpS)LHtC-Q7a}9cx|)CKr6-+AG4?KDs4%?z<$Y~DQPjJoSUL`H@1NjFKW69 zLk`1uP%!z%2f|~MVRCvuu}?0sl8)CA4~F8X^>sE0UwEx|;X+O@;WJIne8zg!6^mr% zDRmwy<8X5z)z5NI_&PoQ;D<^8oM~jFuwr&V4ZhGSz9Ln;W@1~Xlcj_j-=ly0ex?p_ zFKp|T>VyezMfPoWg5TCP>tf_IrGe4eyMOoL(&!cLV9I6*7dWm?^Qm7?o#0(GOjXAc z-(zmy`mWEo;D}YS-N8%lpiSNr=l(7P&K{}%yx8T9l^i$P6s(DSf{;}25mG-Gr^>$Y zm(v>>0}D7OxCmdgoNN7jtqu0M#4z~qxI;U(l)qOu0IJcZ_-oZJsNLdI(oM`MKLl{? z3o&s48%GDy$2T2;f@LX*k;NNDCMUGQYuqrS!4+P;as_XnC!3pZJ)y!O_I5tEH>!Sh z2^;_Ciagc#b5dTofW{N?P+PeaS-13>ETSV3OM(DfPn@9 zoN9QR9xU)ggEs1yyKeZv=`|bICB2XPS)YM3X1`I%-vD}zs z!3gg7A8edA(MH=Htw^a_Gj!C*HGESj3zXcWL6V=%fmy3my)kx4%QNb;1$UbTroO#w z`-k8fXvWb7-Xq=t8MX3r{qMyf>CF-HxpW(R9x!fa_f#4A-hEMN6tn}OLo~tMQ)1xU ztxGG;|= zc-#PI%6J_;KHFjxj+H#CGXZvn+}s3l2l#kQ_x1}RJ5(58|C&~8hwa4)p1x_$5cEg( z70*W#_$xX1Pj$o%qcsnGVW(BZ=HRDUakQ@RGT^~`6;3)>Z9jSU)SM#@6^XHmQ%exM z{fF+%#ChVN)6OYDsfXt6R)b0N2H4u^%-zbT2kp;}pC?V^0ADmeQ*}iV?_caXYhES` zXC^kE+%Ka5`aQ;JH0heyyLkG*&~sTZ*>jYx#!(kY=FZGXEbAe0M_TzoLgf4kJPS{B z5FUg>=e2dU0s8aEF3059q1~*R+i6in{QX0!mBiN$>^zd*ek5T7cBS>lzX(1S%@@6A zRe!!{8CmCF=GQTR5^M54(?$|v9{u^r;{iF$;ZasSe?}B=;naKHrJU)d=YT7 zL!Ud_z5un)Fnqkb=msU@A#FTb*&v{2Z1;yg82z8Mz0b`qMB~8zor5#6L?6b9H}`bT z|Mz-!%FL$%T* zv0sECgGXR@Xh$FSZQPmq5bFhh1#fJP#RS5~59dQ(c4`At!qc`-n!d}SE+oR)i9OT-tdX&%`L)1*G>0(HeR)dzImrocUFTm?)52Eltr>3Brb|>$}rA zPSD{ba)`T&*aGyCRJ(`7Vf-%j-GM$w%xP}(kZKHpGcOFz8&jD=o&%?qg;xT;q7^7B z?A{CiZZr8%F-AhfKFyr_QFh2bTK05fA_ON>sO=M1RXr`Synv7kDLj zt*s&79pkmQevH`L;u6i>QNwn7n76Zj*<9y}PPI~$c7DbvO|*t@UiX3c_T)b<3eM0U zX3-`r8HnqWN6gA6^?-WAGC4BF0{&6!pWEuu#*29`x8!P!p-NxWfbX{hv{0y5l(`2J zbGdiq3m(>3{-yuH^@qN2%pxwgR?`q^7#?umlk~x28_K?)%|SpKTkO(7%%^mwBo_>x z5+1s=;ND1rzq-bDu!f5%0iwIFXU)g3;IwBGhb@tl=H^|?s6J!|^=5?@(c9J_#!dF~ zxT783Tu3&{-q1t^E+ua%DeQ{$ z%(wM*L96r#IyO%Zxa1!sP2T7Nza$y2sc9=hed#^MyS@&%V>!gOMcj+ldsgN$<@G?1 ztU`OJ&=;#SImvZYiG0m`&d_XAC>+^fX|=oQgE8NKzG6KTf+t7c73?AUOFOk47cR;A zL#0`N>9&a%cB)s>v`%|s1#0Tm#L039f7x4AFOHGQWY<8}?0BvimCoYz4d9w-E1!Ox`C_ zyq$8W<`emFgP7YUK3bHZ^pF83UD-PaZdjv_d{)Wl{O!@ik70@947zanVNn@fkRF=J z=P(EPp*)$4LoC>2+x4~iDR>(e(aTYQOJ$%D+NUdOoLsz}?o zCW$hb-eL?{x%*qop`?MjTu%lgZp0Rgn=0d{wAv8Ti!31I)+P0|${4QDysLh@C5GZz zbX6?lcIfahe@eDO6I`1dyCnFWV710DV8hc0U1T69>$?N))oNuY^R@tcQ8=hO`JXqzy&U+KqF>jqfvk%KQrWXE$aHx9+-|Nu$QjiC zTF|p6<_m{klRwi(-wXZ0bc7cmpM{x!Cs_vsOv=hD7B%2unXI1`hX`B8(#ND`_>_FZYIlbbubL%H(-ZFm-D%~`Q+o};nR)xVT4*N9B-UkG zUWl}IC-)Ej1j~12X^v>7S zF;QJBv4$=ev?J8~^F00FjCJWmrhFv&?_FS@T!=)|WBSeGMYb6F9~o(3WHL zu>!%X$|dI>$74tkt^DwpP<)%TPP)CA3?h+_N8bI30WrbA$Oo=T*s+-PI`z369J^A@ zzHdARBDW<%vlK!w?<{}f^e-dqRimE2L+~t9Pial1mxVxad|!EwrxQ?HsFwx(jzT4Y zzrH5n!Nh*qzNa6ofrjf){_%?u;PuJDAT`DpJ6ZqJ;3w0A=%w|=zDL3E-@Oz?Nbx~K zxt4q9t`fQ8Vm|R}N957{q~6X&HD7o+clG{WLuCw49pTn~q7IE;D7R87Rq?in=-Ko4 zoguSfz0QZ|w^rBQx0u+HhZ&VlA*zQ;$V2;Kn2kymvqiT9>b%u~#ZjeqvCkRKCAgPA zGP1?a)T!UsT3xVxIgcf>U@wp<-}VS`+mBvfFOyw}lYwDv3Njtyo%fDH@rS0FBewr% z`lfABA2WE9Efc%-;FAUG!Icc+9H{g2PzqPT{@mB|bi{r&guG(KEZhJGZ`z+5U}eV| zpGE^Ga#Q?Co6=fQV2(vLEiJdoX>q-*{Zz+$L%eK|vVJU#15P=ROxin3oA8|g-M{VjsQ?6VW;q4TDAz4;vJbg~y7W3m7AL`4Tin}oGF zjyu5evl!)P>41^-S+n(~=J?f4RQ!XW6@1%kIZ(^O521UKi~p25VT|bcI~&iWFtq%u z5XCijaCLnk)qRNt65o1O3<|koE1#6r;VlDjerYBX{?-Jhf7}k>I%|(~Vk&E_H>I%n zrCrQ~^Hf@gF`u7~?L z;*Y0~Eve`2VD;pg%@1QPun@QO`SeLU6eL@g+n#pA%EMJzTTHI7`toc#kxGzNIOZiV5VEcXL z{54r}kR47By0rn=o%^A$^@uX0H_PWfI4OekbFZH|>l>kH)myg}It36*xw$csZw|J9 zyFKTIHIed7)F3>!M4@nb<~!AT@H8~!%@bljw3np5>CjW+eqJ|gAmSo{N5AD1SWVi4 zVZ#Hmg+g_djJ~SL#N&iMFIw$whXA_Chv{RT5FOR!8wOAu z-DvRYvMJC^^%r$LCVB!Qk4}Hd)kA|cb!VC$dl;c6BNy@2fh_f;CFdPGWG8#JZa*ZC z^#U!n(N2z#s>@_S@|Y36m#${fXV?+^&b_z%(xgE;jD?%&l{rvRmdx^4D&rTs%$i6k z9sD!d^30f57{o@xE+)N@1qvq(5vBq@a5-^3ysuUm4Y%#drgL=g@7Jf44YBMH|Eq7* z!`=+4--AxwktwZ$a6LBJ2|KLGi=@(&rvsBVDqT@OXV^4a>Oa~dhSl@d@r-X>kXC>G zie7>ojJ%5&WU6%Bx;BoSd-Lvjq&&FK{av{&B?Nk3_Mcguk`zBXeYMEgVF7zp`n~Wn(z!%ZvBuD~TB5uQ4`cnFZrhwV{l0kpu_V zrs!dz0EYEeI(5zY0GM2mN}4c+e~)^@n^)ZNSt{_&O!)Eci!^etU|poCJhoSy;CO~qAITe# z29&5KGkD;o3)42=`|pML5PV3%`Q;#CaOrs4u+bQg;a#!y%5hpCU))PCwiX9_qFH;V zjP;inKBlItkXQ^1(TgrXU0#A@U zZPQ*b#UHPwVs0@?g3u1L->WrOxK~c~-LzK~4V0iPSOi2f=A^AY)(tq*UWxDY<6Pa>Z;&GCTUp!D?~KY038tuA=P2A_Pm z(x!XM1!IGUF6yMa!kHd3qc|fQ2+#c6Rq~eb4c@D)0BI3O_CDR!BWez8bR^G|i2LXR z)pjF}c0IJ6FiM$t;sx$8HR)O%fH{16auv?LIPZ1S<=ZnS;E?UiYLF%JZlUQukDKi9 zQ}nAN6~#n;+~bs|^gUgW`aCdQqGtd1|2a4{ByVj=Xzz);@Oz_w!HzI8&OZn z7d1s%-L<3PhGzKI;*5OB8%wCGdD*3=uYaA#rDY#l?lcHZ=emTIKFxUBfOD*`!StFp(Xopq%4>;%PlR(1lGhU4Bx_J7+9i?syCxxj1wfJ(lKt(>%tv78viLHXY4tq&{Va=gt&E~XG_Hvj9ovD zXx(Cl6|Rz0aw}tW{gdHpM#GHOpU4D|$mKp2_}Q40AU_S&++TVd^e!(7nIrsDilWM6`ZD(LplrCbDp?zs z-RrNdmpI^Ct51QY>H0AF{wW2Sqa#dQ=M2=OH^So2yNdZD#Cv$1yCW@>=u7!p2bo>7 zfhBp7LEBax%&+07i}WTq%idQ%F9|3^`6Yg-83s)_Ty;|1hno-euXXD2U+2J&6>J~x zT@peOYK5q-Ob#?E?XlMIQim)GNl#{JF}M-S)TmUVj}*M$1&&k+pv&{7EbE6xgm={L zkr+7{{-wQHs~>KHtp!UfDuuh zY&i0*pBk{s)C60t7vgipN}Ur;>2T;l&DyHnQTUnk>5_VOHjoX7FV66m;LD`&*ZYOz zprQMotyXwGCJ!9Gz-@=ixM=cVw2@`8Il4cCfkWkK|}3;XIU(T|+j_(rp-jJ+h1GAWk6NMChz|F=zhy!W-D z|K^r4`iv(RXr8KV_0t^4M6(1 z-t^BCDLa#f>eIY1wuYtn8#uu5_Jr4%VgO7X&Y{_&^+SUc@!eBqPWUd{)}c+_ADH*| zUp`_&1@58l<`#E+kamB8p87d^Z27a{|J~XZresOG&YW;Tm$9Qe7fsFZ%p}cB8L2z; zN3!K#d?OB&S3+bj$oSz^*DPil8*8*p>+OPz-e50s+&3ZI8Gc)=vd1nvVzB-*epM=c zw3#cF>%BvGS=$zaG6oERp7`jN+*HHne5cs^0UjVSYnPc2eHg~5DlEqmyiq={Rhz9z z5nGDSC+5l8!#m||o5Twa$agWpQ|Ri~(Y{TKUCCWju*x=R7};+OO`Eg^q}{fts(2~B z?yd+1S*IN4A^LR-7F3s>zxtqMH8`Nf=b(=py#3Q{_mzPuv^DbaJ#FA=);J-zs)Y|64eZfkKMa!4~N3FGtWt@gWJ)?6MKE^ z(9=XP^gnVv469$V)BI-%TU>{J#;e;wmV)vEuZ0|bmfw*sp|VDsTR#r(o)QMDPVL0c zzK-yUqT=9<=i-=GVBr)rqK)Mf@0uv{m4T!FLx!U2Pc1Fk`=4ek1mMG-jXPwiitxy` z(<5$38L8-h)(ex%pvI2Je8Rb#FT2Xw5jCs+~t__NC2XfpJ0OXCpV?K~^2 zDGk;B}kwEx&N^=}cTH5^%Y0j)zqS}QIZ;6G{?Ym($d z@X3}kLSlKbrS)}oAA=o)oXDw{3zWkr3FKsL#CwuHB|B!rO$|I5?myNl(1BWquw#1< z8W7&3mA%I$2u{xFcCWHLZP>ZnTHC=dj4+$b@A6)b=vR1M`og3Q6R#=5v{&XvKMsuQ zolDY3=TqIsFAzQc)rJ_2JyeAEUOo17@DB0)a4xWwR$dQ}ewHeawXuee(Ijr|YRa$& zTJSOoGtI#uZa ziu|Q78;Rbi2xp3oKjBM0Y2wJccvKn^&jxJENZA6$?cK zuoBwncUAxBGlyofCEo@yeXtGw^4M_J2&WRXC7D)@@Ox(n`*OSWYaOquT44V0j)hfoIj*ZvCkFo*(HHq*H8zRrqR-eYHEDU7g z3gSUR8W6fztVd0ujDN)jSo37Xk;COiMtXxHELPUh<=AhJs=K3OyO;!CH#2S2kdlUB z%8sLrB-z-ZU_U8&y#xacoRSZk|Bs^c4(IZ1<8VbNl%2h0@4dd4z4zXGuViM=5K^h6 zvP#la{gmtrC6tvJ4XL!O5~9fay#G5m4t$^IzOU=^InNNBjZxhEo0<;0)kmLRx|#~M z?Q|Wo!e;2~mzA=Snv7fq=S$l^MB`)QwbwG6j!2PCX8Xk<7n*9sKUhS{!o0V4UE{Vi zXg*ju9O`ciUE`(>Gkh^<5%@aFWS16>GTiFbW{rVs^M`*H61k-Px!awO39rpeaMs7; zM{U4!!`oJDl-N(~3yR~Q3c`~=D$~WnP4U&yi}!CSM#EO$qX{QsUhbd#?N>f|I0lF& zHWm?l*3zfi<(igJ@KA!C^~qPFANRW3Ve#!z+~(+>5wfJfh1n8r-Y3W4g##JyNN)g; zvAFnA5joX9$xxWSs}FSMGU2phUO=tz&+p`O!gq`^U1y}iutj!(=Y@(3*e0ob=kig- zqn2z1zW0N1B4>$Qn!**GmU|6i_{>1IB0PLh*OBNoU2`X31o&C##B`0cFErCm`{yN) zkWVU~S?8AorCmG>xEpY{SbmkP2Q)*k4P>d(7N+5>F@ZL8lj^Aj93 z@BS}ULU@~Ai?r&kjTCduGMSciV9p(tFYwh8%408eloRu>_WG}(#|o6O{DIHkwt6MV zbA8WeV8MVycG5GD-4BnjgP+tm<@m9`n zt}}!2xrlh5!{Yd+yePB!0u99f^iLXptOO;N{q*B+mGDsB8CH!QBg{zdm^2Oo$Xe4| zYuRNDHKR>jw7te?B~a;MT569qf0xfLI#`0u)8>Ygy*jXT_QP~dCc*1J|3*~D$QTQ< zZwZ~)Ch{AxQ#zWT4dJ`!qgA;zE6ll@{mxi=})GH zJn~-~j%%9ZEzTF&V!!yH;nAGN6*p5D5EV6i<-J3imB^DyO*cgvRtF{BUjIIC&D$&pWAma3Cs}4{dd=U*ziPL0#3)e;kZ#Xg3oTX?;Nl zX~&$;Che$$$*H?VRS$F^r|#iW50MA*@wv(PBX1K~t3`@3Tsp@|xm%s^=zSP@ z`MgsU#r<3EixwK7sV?0T1|?*S=zzOP6v`#TfP zoqw54F{OeRrPN$cxTwJl(?r49@5-! zU|nwzQbXk1va_S5-+elO>G2mWYW1vvOup+RbA=$DbgUn!COm8c&31P_3Ce@qor|F) zQ+sd;`JMc4N&ye;dcD%^XNQ-kD8lFoZdlyDXG;sOY#>wR&3q)mcTr=f2-QxtL?@xq zfX!eIs2I*Pyu)A&Z<=ixeUceuwLCnTagEZdMHcmaYeypBgQDL{%Xu zS?9VRk)I1Szs2d^t&aKz7N0238vqjzP3(CsRq$Dtz_Vb2;*^0mF1gEN?2U(~+-5AH z$RbY0=srI@)x6Tb(`1G2@|Wa{^=8`hM;IQLJh6b)d0&b27&h$bjO@JTW{9ef(skV4 z%fTQqLUn0!LY98j1s}=;ydtmghxl95TnSpAVW z#&Rn#4x8E<7;}f8nSAaXuk*1`m_t#emdLAwX>OQ{W&&@Uy6RF+5I*t|qM%(*#zSwK zxPKA8Q-)9NQH!Bzuxd$PpE(u|wilD!-i9XQ9-)rCk6$K%`mjtXE5RMT?qA+$9G8oy z5+(eCq#R&bp}@+(_!#hg3{00lJ3T+y7ki{ znoGfGa-5!1=|dR7%bTotUK|0x)4UwEvn&XJ-BNP@SOi`>Bi|D|EQaGUD@znVeV{(| zI$ctsHPUyTv+Wxo&KotUV;!%E{i5FfjKuvq_>)8NSTmU>reD9;x1aD9&Hb^~_W5ZJ zXPRocXG9Ib`LUZzTChEkOgptQWB#=J%U|NMG;_p}Cv6pnXU*^fUfK{Tafhj0iYiY9 zUEuCH`bl;f2wv=2_IEhA-6qe3-KevUyHcAH)wA!VA z*!zHkBX!926(cNF&Sqo`v%?c@@1i-Qt>H)3pCI=SKnO;_I(Mka2+D-0@WEOI?uRqvpzP6vNv*et(h{NNAVY z9luem4tIK9#k(Ru;o&Kj_)^Y-aoK^49W|zK0V+Ra(AwQh+%4 zLpKtwN%XE6*QQFPV7n^9pm0SI<$Lc?vEQ~rp4}JADv0NXME|iaon~jq=WrXzN2RifI{~a)vBQ_UWxs6qNr6Kb8bSIcBBJba7^Y^`AP+Q#Ei59SP9?w)IfIu zzZ~=}&cwu=AaXt)x6l9DBLoxr4_o{0o8h?_a#=?{Z5*|qw4CM8f?@`ge6+Sqk z6Uw}L*aEV1gLAb$tD$Y7S9EWN1(vy)8XqM3tvu&1Hosms1%jQFC1t9Kf-Q+7nMwLs zH@?^O@P0Y)d~~(`-zjY{9Z0&em;Ft9Y-`_JzQvWEvel)0t^ck8yO`Ztx`t{8EL z>|CX^E>iZDazy@ggS}&&PfCkqz^S**+cDMyuWn!Rs+ZY=JYfcDWkc>T{^7#qjV@85 zA73I!u1WBE$}jp=$|%D+Q)QoWjuq&2@)#WOQpZ^S!#0yH2Iw8dm>qpz6C&-uS*W&a zfVhE_^rE5`cCvdNkJl8##=orr3c<>-yT@v`k;HB=WB-~Q|5Xt49LuhIygCTltro{; z?4{A7^~A|=0ZzQU^}YZ0m=1V&ciHQvF`|n7%+>=FBfQGn#GCR<7SsmkdFZAH|3G)u z(_-c3`t(va|dW5oEp&>VhMCN^MMkmamIc4Xv*&z!olFYsDCuWGYLj{M+{4L=1 z*xjE8inPIryrAJNaSkmCZN8A@qk#wRDYxoo5p!s-V*GMb14g38Jvt&)P><&?{kEJo zDunTWoRg&op)YsWH!kbKljdhGG8z)V`<`5=k?=AMZ7@ixg(#uFwlUw6P!rgDr8Qk& zTphG)&j-xBH^(Y>eGm7qZoraTDXP?)2#;>Ac+G@)K+26y+6nf?P~>>Tm3MvAV9FsEgr&I=?+EfxnR#V`=mJ4B;sE4 z)Kjy<4Q~JWDmKcK45jRKCqsxFMK^T-bMEgLJYBix*+XX^$hNb4|A{!qpUnGsly}4( zX_KNip84sb?6L4_U8Z1U$T;!&ub(qWWO_>4=S2cPl$N{5(v(m_()S}3je+=%ys#hBc%$}Jnf<@eo$~a!BDD;QbGUe%4oa87e$}S z-~N)YOKCfh&74p*%?=)KTJS=Tp5tAi1W%XCfB7OQoE>Qry4ll>h~H=QrIS-df}oj2 zHqi3j6N;k$dw2SYAy$T;d$M)h4|R;|-tg>kg7)RX@RW}#&|kJ%o&r|Ls+@6_v}A%C z=Q$)riF51ttNhE;WWKku2lqSMxkIt$zAIZ#oMF1!b#-9C z4z13w-MZDtf)oqG)b!rQusq{fz2}@1hM#2ox_-$Pf4UxPoA{y)b!`6R4FXay^~^xh z_qrjr1xvQ=I;x0X4`R{`LyX{ilP|UZ8FiqjR5&F1!wTolBt%agBzU-&E(u{VBUGTNMasLmTAy&!h3Ofughd+ zNvFwPb6=13BIY?-rz2Ta(gbho$-wM0LpQXP8fg+{SH%gJ1l4B)ws3f& zWA9-izw|=DtYnqodrIkAYnie!;B6KgMfy=Kc+y^dHR7Wd1aw?in5QpU+6%o2F#4whMY>ZhO)+Qvv;!e zk@fLJYsQ#0wpawYub>W4md%GBykH4)bJ-8J>51Mq0j@2}Av_wQ>MsvY3PDwVR?||R z1sq|O;I1QjWU(77q7~OIG0juLx%o4Z-}tiR;Xh049i|U<^G?5S-?e>m?RCB?Qr>a% z;T~kg54?RNb3*&zeD3N@3=P0o&3^jMw+c}6pR$oD@qNm>xuT!+=;HC)BVwuj_OO1B zR;I*L7xW}0y_DIUu=tS{*?1KRo7jbPh5xvKfe0hVp$R^a4f?^{NbADcxRvyhHVd4R-p`pqAWBs^}gtvxs`fk|UgM-LUqTDud&QH{lq>v-HvhU22 zBu$i%#DBYz{)R2=dn>p`FRTawoH4zzdFHqs8EBq&N)8oYvA*mt*MSbpWINffGO#+c z$mX>wMfk|X_OITRCwc6sN($KKN>mfF!^Wp(W z5ji~&{B1w>xBd%VE;WNoSAFIhDFTqTt^SgvP!^hQXWqHk>joVUgAP#;T#|1i`>C7D zj$-kUxq(Pm2C}NQPyOR{f<=$dp}euN5HI18(0tzq;cWU|-k~BCbG#g>wHyr-s7tK}WgZRc5{m03y;P(Kx z8mFfj?82zOryqKQmO(g^kckBjk@FtYaVPST`poD|3M4qc^xk%R{ouuoFaC5@UikR- z$UPV}hj6QqgR7T=;qY+tqyJWu(PhtEgeVH*%RGwUz2Bl>B(2nj?xr_NUf~;SFpfgm zQ=`LK9M%M{_;J*hlqJC*F|!Hd3&0;I_IzkC79{q)@90$X4M2`w@qqyY(GRldy18}$ zfUb1${b^b!tj| z;`IYI_}c%y$#lOp#9``oDq3Qz#GXj2i*Ch_9M$AF#F|~wtVgPVY zzE2k=dJay@X-bpce)y-ir%IC8>y}<@Q@z~p3d35~eHH|N>vxfFZ%ZW~-qF#>xj-%j zKWf`Fy?uX?q!PquiwWK;{h?6P-d_FsAtJT;MN5^lKnd z+}c#fKY{z^e+B43;3K<)-b^+WlJ+@y@0l>ZTmF9kJBun@Ew*m>yRHfOvMioPu@)H3 zlYYgs)eIGjGtZKLvVtke2K}e5dhoCFq2u#M_9!;-*jtMqP){m0%_f21J@&pzNzKp& z&$~%CNn84BqL|uLF?-m;3oA`bl3x(-pSD5y6*e=1n-ETU_cGx_xEGu@d!*YPU#+vf zij=lOQjehLv$r1L@h&ep#>X5S;>R3n)}3(nN`%6;sR@Riuv)4=Wdl~_Pu-67>VwOd zv&{a?HfVfgWn!D~)YT+1O%}IW!pcp1uezhU1RwO!Q5k(bG|0OBvgeI9v5$5!8Zy%$ ze3va62d?OVkiT8W;6Xtoqq{hMb4(A9+!+h>v805|12k-w7H06XF}5X%nFV&5f+wnm ztnsY#f{D&E0i@_Yyv0KBN*?j(8~+RWOS<%stDd}>@aiPio)jZz0*V2puLVTj<$QJJ z?!SqGXnrPtQpVH}p9@eo$Oa#Vt7A(iYq~Wd%&bB~!kZB}_li<~6_LbJiKwTpl!ExG z=Vn9P3M;-D7^NiDkf3rgS|av>D&$!e^2!~wz`$YsK}QR1oP2wV>sE*z#0QezJ~}~y zkQp0J6J2}sPx>MZZHl;PeViNx93VZ_Rp)a7ABcwc1?gMbW2BDN@TjgN*go!Ziu_^& zwLMX>>oj`UTv2FthR8>WzM}Xr(m?ohtWC0Wi5%L@sbQlpEyU+>+;H;kKUI_t&n8b8 zcYv>ddg|O3`YlVCY~RggSt*C%+?5a&=Vvcid>65*^!x-CnN4ecIT(hIDWk_+ zgo|LX!C}hqUn-D^IK+H>avZsbtI0N6W8lM)vs_A|$>6^eR=dmA0&4vQ9_o-KqpHo{ zrXXuKjN8M0R=n65nyb|{W?rbE!*l9QMJ*$Qc*jRaw|wDwhn4a@pGYYF{p`(q4T4L0 zl&){}cMyubdgt%l?FXa!e&_Oie4#zbzSKS`1lRHzuT+QV0E6&W{zKd_<`U@$yB@_eiZ_JFJ&4}y|u(+)h;B;3?G6I+Y`z{6#&{U&Ah>h z58GF)l(Z&m-O&8nz0XE#b|@a<$n^AqE*i0Gdk(#{gx8J5%b zy{L{r{YCe$Vvi$%&nfL;W|BYn6i7|W7CPftk`%?Pfe#wC?7Lqe?gr{t*(Zj$eSos( zgb?MhFx(r+zQO!~m`_ntWY5SLLw2n2>8&O|$WWT1+9dwIPgH0QwlCXy&hx~8jVZTza<5-Idl z2t%(2tQ8O1gW1HMSt=(f^fc^iNn;mB8Ko{}Ssp#;eLMd-i?~vRzCgyR|2TqpA!9Hm$4q4H3`%H6T|cpvBjr(Sqb35!1A8$T!&OXSR2 zsl{LJ6d2>+Z~J@pM6Tpo1&4VmFOlDs9Z_5X4NPV)OrI22!F*Bv8p?Bo|MutG8s_J+ z_$}vv!$zYCy6%aXTT3v8%W4lAKk!??oqGL1F(xZK3X97s5z=M#OuDKa)Zr5WrrQ2Kl_`yBIg*b8)~lE zyb1;zbo3FqH#Xu4Pt}iHiugm^OZExK!doxA^{mCV`{4{C$a z%L`|wyj`$r1_~bw1Aekwy5Udj1T=?C-$(?@5`OI4%({a%nC>cX_p3|@t#3U;ss&?s zvE$p?=-m2uSr!y;M)3#Ukq5ndR@>R5 zy12iH{rE0cd5n8+-Yv>S@N^_r#JGD1Zr+J=?;CflQKa^Vc30^h%q})&X_d5rA@Af= z|4d?!#C*B+=YJN+wk?gFM89&k#AJo|P&(61gb& z7tw08n#iNq!DR=VLK#dgxLCbSsSP)SWw}TkhvAzDn=;EGBiyDe*vmt|(9SpX^SdxH zCv#Xhtm>#rydPHe#|&akaNrqFqSqwB$$Xe@H*%loQS1u0=^*B?yb=P_l3NCNzmidq ze1VwvGn!mB)zJrUU)$B%ZbwXa+)PS|(MDOEAGu@b1P?w>X$h@rL6BB*eQ=QjG8G-} z8D!GM!Y=#KErN^Z_g`E;(W*|&L9wU@#gxP zM&x+L_e+!Rr6CJ*Sr4zYKNgKB@V1zS!{)_FkvLm_xRyv-*2@XTUs5-w^Md>!@}q;; z?QY^dp}wJ3>J^A8O#DKEzW(TT#v=Z?tThsH^QT-XzL52Sd-$q{C9HoM9&dX=%w5l| zEVj`T+@Y&tRpkuIAfyPL-n{-;60)>=VL=ez=R^$c{q7CNm;afpQfT576%?nNMPS)Z z!Kwahp7^sXrO5qDBG?Q+ac|fZgQxW$?>zqNhBf;CRh0bF0p9aLmv_H)hdb(do?OIS z(ZTF^P!_I{zH(|Y3F}6}Q|7s4c6nPE@h_lpl?=hbM;nihIXR(M7uD}_sc^W%C9J0Z z+7r?qo^6~ah2bkDKZn>V7MxYQA>T?92ofiPRF}<(dvHfbTM5A{5;-q+`AaB2Hf%L~ z`x?duhtGSHtv7a)^z{6-&!ZN+qT2Vx&w~WtUMQuQ?k7CoDdRfBV}qKqg8vf!p2oA+0slMQkRN>006fPTv(E_nz})29#j8i$2p;Y6ftFEI zfc-B27tS}0+I!mjF@9GOb@2>yQPPyQg-uur2 zh~hzDtphNfo^T2y`p|}n4~y^18=~9MBjA>lz#MWvyBZ6o3(oDJ76q(FZB+>_F+cj7EPh9?G0HQvGVOCfMb$Z)4_s5%IUv;z8 z^)Wp#XC4vHjL`$W1O9u>h#cJj?RVxn0pc7)#~JcR-UP_+f06sTYy#6I7yf=#(Z|O1 z!iLy&Bjmh4uIn*w0GryC7aY9wVIp0d7A{)gp>rK_I?-Ba{Vwa+62U(Rxfk%um0An# zY%w@oC-NN1>0yD~IYf_2e=DCTje?qXt^K=3JJ5I&zUIv6h>FvyO7D2>vDR@y(Iw3l zZb!RH>k)H^e^w%%x|!~Hbolo?8Igx&8qYg)X~q+#{o_CUEw+Xa&-wLDt-NshnZTKq zd3}5%D!UhR-Jx7}cuZhI76#Yk#e%4uu!#5L!%9tA;JCrF?>Lb^nB+>(=~1hVLZ9)RQmVNQ%%KX7}>bV`|K2 z?V5iv^S!+hzkhAZrU&yBucZBcB;@w8Q5fpm19oCx&U$egg5_93j;)Irw#+?~IbCIe z9fF=}s)va=n#qNi7cSX=@#Si<2X{4aVwt-U zWQC8&Q($;SUku$rEw~=@%l^h|X(*F!BQNH&z)K2lgMQR1xLY9U-JLgf@bT*bt;Jpq zpj?x+LLEo!E$y^F)j)7Nbl+BfkZ}aha-UicT1_AeSZ`%~;(&i+w&a$n)sfFr&OA=R z4mg?R^5c{hp`_L;nTOH}|D_-J8x}2tg=QjMRcw0TcqFNLhb;^aG9Ewa*lhsmCt1wq zJ;Ra1_{OD;d%+NYq+F^Xg~+Gm|5!cfk&0x}?lgAF;iw;Q+wHG{5j1u^crB_H4fppS z&X!;e1HC&9D4pStv_&ueW_26FncOy2mv_;?5#^Boz+D3GUEY8Qfm68ehw|G`gwOi! zc-W_Sf}#aR$8Gv_2nP9>=a9U5|5d0%7|v59f%l z+keZ6M(U^q{&HdbJAXj}I`th6-TEg2t>38lWi!p7LxHmSobtqgL9QLG%P?_04Zlf8` zvVrreVgE1ULg&Rq;tX0rO_kSV_Jk)FZzn+30)|^VP0G@wb@>IjYhUTmiYV$ zc->}+YMxA1hT&1h-fNa-a3o>tq>GOM z-WB^V-ibK3L@Ow5H1!!lqRX|tYSHv?TG;o2bhRdqbMLq`N?3uV$DBvKEd$VIOoja< z@|dKp=;)>cTzFQtt#*fA4w!7)jN-i zQEPj1p2-9~AFlKVd+5Ps)4t5?vzE|MzkTedvmwEqIS_k_$jzs8a8}xXv4Yj?BL%J& zwosdma8=3v#giqeP zcb8pM2FcU=BiAa3IVsEh@<)DM#IS8knFf1oBIl8kkT(FX)1@wvCZ@36?CVVVKnqir zKRtW(R2wS_Bwv~_C_!)i_BNG^B>d48Chfm3jFP;o0{ z=D6`*m96Wg9=@Bne{E);6^Pvx=j|sv^M==3qV%s?B1?4e;e9h=*ieT8Ugs>KNi)FO@+K{$=9NKbRb@8PxF~c9=IX)e)=_o63!`<`sLh{LlGNB z{acqg;GfUcM>+Kbzo|izJN=RXbZnXN*Y**d?Qcb)H371CEAWdWCBG>gmC;WAb(AOs zjkq4~XEjH@1eQ*7q94|zJ8egI${Y;y0tNFHW8ojYMalqGFpPbzVwh|8z?^~6MGi_I zFjD?nbDl94tbV+-Rc>=9`a3<>)b=FdhqkR{?oUz36?Er69{(e_MW@i}#w`GQ2JPr4 zb{oPArM*i>y<-SN#4=hWpnntP+bZiC)t z=#2)R`IT~6BsvJkq-7-!xO>4R;qM_NBNwo{Ru&zctBrH}_~yn;&7ncC*Kd@_V;N|9 z>8%p^=;IQ4ndLV{4RUI z)AEOzFRYx29DC1shEd`<<*~YSC6}20D}OGX%#+8i63^o6+&ZxG@z6sN9X)XS`aP-f zpDyk;9Nbf0PvpO@R@L;slE8p2f%Ch zawgLL2rviP#Y^n;+^P^^^Uo+C`WyWS0 z7%FKK^n;i~MVy-)I%f)uhi|51iy2aUEJ^fiwZtj;=o2=qw(zj?(!eUqa@T4clf7l-_QY(Gj+Kte8mWC|0~-H z9@0hMYYYb>PZ;3g-+x;p`t^wOOQt_#whk;tmeSTY>Y!;xo^tA5c}(uSvBl-D4u0WQ zJ#jvSpJ;z8(>Drc-1RmfWLSBL*~d~&E5pgi^GAAMCbl16t_q8zL^s2E|J*vtI7_|!~F8yMh|0-$!QDkL~COHlJcb~oB`NBlvQd*nBu-x zwkO$qzuM2f5qiC&t zb%Az2srhiSKW3KxtbgFDiUv*zzt0^F2L8KeIBh>i!szPIgN>+YOiX3nbMBH0a8$_l zC#Y*dx$`JnUMbOgI$+%Q%k{8-LnY_f-vcoeIX%84@J0MvB{>0!*bO79NlJe;MuylpB^PavC@|Il)D)o;ma|Q z_+<#a!Hx$X_8mr#m6w}YL=Qn`SE=hYf-9Iv9-lg~s13B*94p`d-zO?P(@J?y75!6d zHpYrAQJ&n~?T(@u%zx-ls@tar3x~P(Y~9hqi{5Oe6izIl>n3vZempv{`_HNZ2MQfekj!5d5OaxO{C0BtgvjbAJscJzUMB8c|SFL^f{K^R=y_ z*rYK1`MI~o1=TfIc8{q=a@U!pMT5x3fz&$JCd?xW%DP=249xI~WWmY~E$MqxT zB==o>*jr#_elJi6EXu1x;~CU3QTluc?sVfVac=aoUdVcWTMiQSWy$JK8De#z z=d6T17h3W~gcJwr!sxumiMld*oXLM3l2fOKaiX&|%Vb*M+<4rJ>ZKGcsLC*v@*3df z4%64qx`gmp(8J$v&zJzg>YtNwC5QQ&p8vwb2wq0yD+BF)f7)w1bsv$`jlq%r>{;&= z9(X}RQFSrM03R(qh}uw~K$A@$PrXhpxI}v+fi_tLZ)ObJ%-71}-UlxVtaghM=j6XJ z#b4xrEAg!9&24aTo>ne})Fo zkXQOBg-IO!Uu6$TcNn2|L(Ws%{RH1;wa+c@fhhzlm3-ctNc5^4JSoHZ4ACj|(^*9# zKkV~o-_DH=EogW#o+(XlfmO7!L3Ew6n8lV5zeI30ZXS54-A(tEBqw-Ki6_z=4_yoC zp79lijx5H=qSHk0_v78NdMyZf|i&gvfcFE%Msn2-d8y%hvEI> zCA-Pk36E6ep5%v)5pav?NK!bbJetc~-(MC-_{P|ymn>)8V07!syKfr~__}ZI9iL_h z((FAllI49ABnjM3G2tnoI2GEeI7IYvhBm5X*iA4^nNBcGGZJD=GMFL^R~n~F$yF);MbGa>*!iVgEr z_88#3eP{Z#yzSB2d1o-^g*KSjk&W&=iN-7!4XqSeR`~gN%G<7$;4#K3joA@v)-{DuU#^Zl9q z6_R*uoUSTwgM`O43nRMpjF36QyPBES7&>`&=dIGYfr*t;H+3lC0Xdd3ZaC+Rw{MlF zdj(2ijJ3SWg{Op{WN@otpQ<*5T>p@p7GR6!&z(5BW38~DpO=l`cEFIq(0{oB`+@wI za@^+hEGVBBeal1Y+Lt|cs?-uto@q#;-6?GrM?FiHpJ#JwHb%~)YLo=E< z=0(|IMsI=?`wr-zU?qBaewm8LB}^b*dU!^%LYwf%j&)4r2!rCcx!62iMKBGSSd-!< zp@hENE(Qx}1f9%0?f(?OwlIh1&_6k7_;halg`o;wSC@G7+e8(!N}k755xLu^0o%C4 zX+Y#ZZ^^03+9UIJm=K$?KH9Ksu6#>1hFd}Lb8YDwP_3Tpx%S=!%bXqxz4zC~jrfG& z>LhEpLT6J|RUnS?4!cNyi8=GjtII$5q=>nYZp4}-F(2s53?8wx=p}i%zRd1ELHwSc zrEzJTP=YtlLSgx-6}0HC{+!m-Lc4>m?02|qQSb9>O6EL$m?Q7*boDTXT|Z9wWE1ln zx%%W?@PUN&`zWvY*z16*(vvZR{Uk`I(PckqV1Q9&)Up4{Nq9H<1#RUK1NhPNg1L)R z2XwwJsQuVYLXCy!2gly(c zl7=5z*y#41dn5x%u~)8m-k2fv*ZL~8m@6WU+wBJw49duSWJqw-T^)FCvvc?~@e;nw zW)UrMVdTpfeByD41%>4)Ki}V$g^l?(`+;F*Y-`iJy7EW?TZD>-RHF1T+r`6pjNH>nee59$N;vdxQF!J#ljczT2ISR1sy>fz$Wsm=uQ zlyrIEy*$#~OHT&YbEUH;5(-Ee7~PWI&H@WUw9E{@1mPz=txy2rYuT~WSa|5kj4V{s zhQA2^MXcz%Q~FnS<7cPHDkff89FWbcX(l{=AMHz?xGBkk^}Jw0MVbmmTa<4~Hi}|l z`tK8mm;hW(^i}CP?!%JnMdv>cYGC0qk4My78Cd&Zn)>^hEIfXy9~aK9Ma&JU@39IT zM1I$x=~^NmHg(|21;v*#IH@S@P((w*(&_c*qo1_k=#0S5cCG?gg{?GGE1O_x4V&e^0on?vUQPgPpKsUf%E-toKWh0A%ZqaSmPAzWDb>d_p6D`v*3+>k)`> z;TqzJ$3uXDXT+$?J{E!!GIt*v^g`pF@hwgL5ZqF!T&1zGM$daL^abKSa)wKk$U!Nl*AESwzpmCJo$i(eH8A z5365YVi@0WfxAh8g2_RiP;4FV^V;4Cj|Im)A={(Tp^ZuGpt!#YFc zzP3b6q7vQgVAJ;I&pYy#K=$S}<2f38+3tbTk}Wm7SRW#CiD5b%zE(m&W=b77~peG(G4aC zN<35envpqG2|kp*Y5!J3@LZ40)!rnYvuQJS1}0=CU`iGEKA}?=4BviaNgGfmp3f19 z6R9Rx?`xEhyrK^GT3<9pOPaxXk?mtTJ6iZ-D1m{AINy9u;(V=4tqhriG9OnEFy zB*Eo28O%2fvuEVC#)6(-`9TGW@J)xA&N|B$kcT?klbs*;waf}AZ`ffYqv2hSI%)WO zh^akM&H=J^;LG=EE$mu&bM?OtJHnUsZsKi*Dp+q-FZVvT0;W7x!K*JNusm1q62*N3 zBFFa0$_e^d!l1Qtuv!Ee*XFB54-lOFD`%$;wf-h?tj(Xx zkTAho8L`&4vP?+LJ3SWaW(1@o7JMW7=pmuERyjdcpUAt|v}nGQz`f^mqFUJr?m?~2 z#L}=VsEpiSyJf(Ov*i(GHNILXbnr>A(`}*$EAPa8NyPxxOU+GxH;^DxTXAt~$QYjl zp0>-l4*18yY(C<$8Jvzo!{7eO;GXZBoo`@d*kKX6K4V zm)*oY;M1|dNOhDXPF1}@!eD0P!o@Kq1J-hHWjcttTFdZj__TU(N~4$%*dGCM1D|I?#A-f9UT;DZ$IUj$B7&yMg0#%UbZb* zInFC~qTOA3BKz1naeutcl1&@L3mm*w$-2H0;N5h0<<}(!OwE!WHI`l@sT^@}d47x? z*l!gc2~>1~$TOA#heKUqsNI?&J?%!Y?15Hw?tRi$|B3J|$sKOw79o zM`!q)#N6mM7YFeJO%#oMUikUL%PSXW3Gb@-)eC)RkHTP5FLUhvD4_rRpG2s(7g`+0 zEAF5DVTm<&?Z8kNR8f3zlA(417f$Nh7WYs*;nXBO!Rm!sANV(KJ<=q64GsMl3BSN4 zi(kLZjRc84Zl-pvpf>2Ni!r~k^T7O z8$Nc`pf*<+3p}WO&_xjLzR|z)o#crP!2`YvAdSd(zDwh{4ZJw2b#KI78RT>?K7aba z3R6z2-YbmyMWQDENY+c_KbLMZNU{+Bk2$xVa+kbxMY*2~s)oNfuxd6}Wy)4m;#vxxza}jGp{NQJ9=`BrAJJDA(SDoQAl^&M*3&^S=Cx^4MhH6io0CF`qHUB56 zinEesXWGOyAhYnZHQTT>{9^xi)YM)M+jiP@?mrR%-B&LlD4-Ge_^A z`mT$kipnO}PYGj)Pd{_uUSl}aDDZvOK@U44xvdRLfX02OYlA znx{9_AWi;UiDG~So=I~&V11F`t&fx+lg%&!9d*HQ@{1P4=i=chL&D3lLY-a_udk0L zSrPk9G;M(+j@p@uK@e(F54q;OvnKcy%^&CG#X#y7TjhxoTbQVIR7hr1LDo9e!9xTu zjEY&b`5liIyr0-x9kpf;j7-9B*p6u9DgRa0Yp!-^aKbIyKtK=Jx~IL9-&%pxY=Vz4 z!P96mBJcmsriUI6i~S!Eqnj&5|D)(U+`0PSIBd`Cz4zXGe;#}9y^;}%tcFrlR78^` z6b(W`NrZ2Go@5j$ZDdpkkzKa@&hHO!xm@Qs=Y5{%^}6rW+H=g>1fT6}QAdRdDjDkL z%29FQqp)o2d&K!u@7*`wv?w&No@z3Ui;f+3k>2=F4~QX0{*c#)XdMvR zkvM4=X9$bQ)i!T`SzxB0?9*>r=2)ZH8C@J^3*u!a4c87@!N+`|wX7gVl>bgUX5MLz zDVbrL>I2T;9(Y$xJysvYo^C}jR=J?<=rKAU2Q}nW+5g%i!x6rlN#Ezo5PW2aur^b5lf*X=w8PYuxev>%xLR57wZ z+hn*_9T|+cCY|YZ!7$UGfBlLSFn;-VY1&yA*+$*V$GWAVGgPJ}kVzM=)!%`W8(Qc& zzmmBBwiX(Fw7Q)h4cMcG9CH|JN z$WU}SVExbZjUNcjbmhOCvO=EstfAM5`N6IyPoF%oB>1n4yVn#deIR4U3(YHggJ8#k zt+8~fAO2WMN;;DXn0GOo=ipHf*pRK`X_RNcA6J-WxG0_RW7omP2lmkf|L%m?GCh&g zE*RfgBI1RIOP?Nk$WF}tX&}nt_ih-9xqgabFX3xuD3CjI&Knc-ROeZyv4ZSh|RX4G2seP_+-Yv%Jh;K*tU;{JdTcs&>{OwGtNE8?@~w-qw>PS(>#(B zWr5JI?wI-fh$%#N`e<+vT&_jVA6+f11kaB0%g#wFZ+Mo@u_tbk$eT_{ITjOh#K9Yz z*D_7~q2G;l`?_o=iAr4f%#gAzwjMcQJULE+6FK{rmCVgRM7p*+xzP zp@zSV%mlB9f$lqZ$WK@75H|>zA2fww#uL|A5BtG=U6-?S2@d$rST-x0&m3KxI-mTW z(E+2=0^)0wJCMiY60`odHzcp@ceT0=GVr>MH|Axs7N(UC8(#4+1bf-j6dhu2uyS^) zG+RIij`SSdH?!`GIuToC7jKwj_7|}P&Tu!_-g|7}HH#dopLsp-&PgB1{UgdyZt#x76 z5*OY+Srb&E1)B9z&P)5%A$fh`k(0bR3>2RndqY1;w%Fm8Sbkdv-~8K+f_;YQqS3fF zc2gQ6x@#`CrRl@ZSA8XVrwBf(VBy=!w?eo}Qs5~+FFSyCwVVD)Ltg@O(fh{NygCcjKkY&;=dO2QmBx0Kw{i2h!& z6{o2)Aw=L4B9%%Vu*7+fqc+(@o*?nmviFHMws5o4vh`xN8>Bw`Jmi+(iRv8-f)x^; zIQ1oWUxm9rkgp50&Pcn$BV#R_Cpmt2?S4<~V_F;R4duTtMdJ^bnv4pBvd!SfcNvW= zVy`Oq*1E}7S_=RDitN_1_JP#XeOu0V3Gdqesl>Edca#}fuSiO?gQBm$&!>$z!Y3Pv zRV7oxr}37_LZ`(7OKTTN0l|$2SJe!^}}wUApeYH#eAYzn3h1 z)*O;|98)KrNI0#OK6QuKZxtzjnfvGK0W^y=YWz-GKzG<&El$)OUpr|Y$hQ#3f*amD zKYn(B9(@hZ11*c>U$o8SMrv!MJNU4MI!X=n`!3u2N*O|3>+r9sSOc6qQAIf(&4U#? zixa;dB>M7Pr32J`>*Uq+wb}IuJ( zG}HpIHnpOZTn}h+$ZlecA>NO|L62ZN0Gmu^jbm8@A?Y7oS$j+ZH2&G^Zhy-dEIL)< zAGq$vcuzO=jfYxjtKxU*4P_i$VVymY$!37nQY$Z=UBj{Q)5I`Y(~IzS&ogQ5cZ1~X zkEOY3?9f<-*DLqc9*kvL7owu^1MdF{sh#(_5x$EV0W9~z1-8yK4rQy4R@4t{IbZGJMmMNiTdA#}^+CPH zjbleTIWa{j%v#;b52}G{>5Qf&F0=gi&O1UHQ>DKoh>B=I=O3HrW=Fj6rs`k8Kxqx| zJvAiiOyrukKBkV7?cMRmo6kR=X@nueD7EwYQBSxZ?J8$Z1ePjsHtg)jp!Q1z*F%=ybf$GCMd5-{W{6|8FTnG5Z4fx9W3(dTjru1!trj;oK%2wvM*ef?Jh zsAzHCl|np!OVUXnei8e5sgdK}iByWjzQEHi`8mPIr@ZR@>aremi;Fz{ahQY^T%np& z)8a^D?%sZ{+7Nnw{ynoTs(^eBMj7j}8aNWxK+-aihks3eosw6SQLnZ68RN1Xa7K*W zY&f6|A8l?&Q(LRz0By`){TqPo$E-NinvH;M+EPy~SO7nuS=d$;9So-Lx-JO1W(AuOtd2`7O<`-rK zlSZBK+l;-u{ug7k{zI*rw&D!IAV|+qWC)G@fBtCp*kbN|-(mVode{{od9J3$0yIUx z2FidIY+lX%_kP|Om458Vys=veQ~h0)&cBw2Ao2)r-g6bO-c+hkwGf5W!)Ar{#5u3d z=*RLY23@4AJrE>E?5S_$92>sCqYG9q49;irTVUY5JJK9s#&|(`cWUTMJ2?N?&9Kwi z1XSm8)y;^UclFCZYGPal_=ZPe_gJL^%o=dW`h8J@^`MNhkOg~m_B|l2qr#7G=w$r% z6S;?h$|rLn%~JR>qVDK|p(Y-CUd!q#VFaV$)zxn0%pejXJ?2+thM#Bdo-N@Pfbb{t zIpJjlzi+@GipPVz#vnhMi=?%8JOn5c87r@7eQSI3@P^25CJ2 z+;ERf)8|n5E97G6GDGx&UzJOh@`}OBoF&`Yc}6awJ^58{}+4 z^iNoQ3+(-c<*-RA?h>nB7;+}G+x;Z?2a8{o3hL7pLBZmguW^MhW>zr06RlFlov%$e z^OFHj8w-WEQ~DAAPX~El(FDP#_LjGLGww(``f#w|Qy^x(bZ@*y;RPW&TOp%(6UHIjUnK#CV9oF0k-`>@APH`uY<~^>L zx5))hnK}b?3dM5n7LnJbFkJ2+Rc#U_{%LHf`C~7SwAq!Jl9t-Ik3wYG>pd@OJt;F0x~U7d z7g?LUB-EfNbLCpcWm#~DSS) zE#iD|Am7hwmXtQwV&BPThkWnT*c#YPU@P_F@KA*fxSi+S?!IG-)nVz0BwusPDf#_( zp~V=!K0EZym^uFAmLc?0 znO~$Q=4snqCN%||a`?LOoznL)ZCq>!ZJ_!of%iDHw#Nq~vDwuBS$j8;n>xv+dNhm= z9z1YA-?GgB47;j#`&4QZ`@hDht-S`wo9@VSL(L3csV@zq4=Y5BJ5!#dGsL2Xul@}` zj39#V()O)E8CZ8p65h%oIN-nB%j%Y-@sP)Gr#F)=yp1j*;%l<-yjsBZ;9h$?X=@y= z>`INjKE@{lemg+n3wf`o&*CUJ)ARmXi4*SM5>dQaZ329BH2ZAJ9l+?kKlOD_i{-H0b67J!JcTNkW%4g|e?e@v4FnvGRYavIQLR_!; z6S^7nbpDt*NK@F+FibvW?{lEzybrLQ(8_@xS@iY0*%fxq1DDLJzHtfy2q}2Hy?V$F z(tOF?^BtB*RlS-0QJ93A9^W=8hHRi`>3T#DpFSLG{ZUu6%NeP;6uh&aXb^L5_8aFu zx`O!*{?VR91>pZAZ!G%Q1twnHe#@JLxnL^rqhhytIWGoGxl;AH);iECpL*plNfrgZ>6~LZZH&9mJMDUKOCIic zxGFzSHGzrBn1$Xl!n>got{nTaD9H*|ZEQr4MgvW;opMrr27Dup$ z*iy)Y@VASaR2~6%_HujxFY#T{FY*#JcMC$@i$iaBNciARig+RU7f~n?GBBlR9Rw7q zO4pXzeQ~Jlk@(Hs;rJ!sQ_J`ZM+kaqcQEzDPMFW?koaX7LhvCi&ug!ng6p4LQ zurD>Zf~U*}SpJ0Usr}`Kh9481%f5zUj=>G5lpJDjDl8_k#ux;;RdUqwnPyN{n>Kkf z)gArv3X|w}`eN_aFW1Ua<7;R?w;CFdP+)db@ep2=Bb*ooh>t0J_*$ zj#k88W?KLIrANfPK(G3!;yq4v_?DWwwZF?AqIEUS3nvnOq=#vBZlCQScWiax)1U+R z-7YE6d}@sy9up@nf-KTodA>R7xEOYyQ_P?>mGoTzr;%L6CVU zh0YzhO*vmT)2U%Zxsr7E7?G<>I-dN&Km=o)9x0~sXyfsScX2!))Zo&9OX4d}cNn}d zsaJKZha527Z}W)V6}_MIGYM}JIn?&PP4HBPR_*QcEZGj=nb@?o#!bwzQ*D$3cd6qp zu7TBr> zZG2hzBWyhI=D^Uq#WG{uRloIAyi6N+I+&V?L}j)dnV4mJ>Sb+W580B*r>H4P*aX^6@h@1i9j#ko0I(cSlYjie5H*cMd&#Tj94rU37aXX2P&J|AyOLjt3a zNS1^*d;}k(r!oAhK62fxmu~tkf;2(;6M3KcfxM=lE}qT?I$}}x*PXZ_pyItvK!YL> zs)Cxr5KZ){E0L zG+hUaWaG@X>FuHB!9TIz^s*qhqd|colGqdI)b#erae(mTxh!EH52)oVHi%j_L8d3W zf@PIG(MVm!&uq#P_WgN(l7Zl}It9wiM{8T7bA5CHCA&5LWTJ|cQMU%B^G$s*TSV`Z z*1Z1wCBg@6dqksL&ImP}*p(==9ALHen!!a@B}n!Pnq&CUgmfukT z4&E=!94Ex^Ky+X0iFRom=J}e&-Xj5aKMw0T+>t=?J0GX!N?KI%QHwaGqz(4k+*bpY zIbiVIJF|~}4bgn0^D$lCJlQhaLm@9)5B45aT}*6Z$9&ccHL@A%XjFQfMz%--mVK*V zY-UfBUN3(5`EWu7^JWJBm@CV{ZL8>9v)R2wpKky0D>PBqQMxkN9v=eTB~to|4?JLX z2jx4PW_cv5Tw8f36N30*PwejR($LtdH_5FT0`X%aR7uj_(7P|%KxEDbYo1Rt_c#(> z&s~4pH8w+_K>8wsWS$*9nWMbmUgC-;|09$3TnGlMz=E&QJkd~ZJ5jE*;ERkcw=dmy zH2~wUP8#)^k-#tTEW9y|gxc8wS~qpXVXgGtrNsk4JR zE}!eEafJOhO}SHsLy(7a(MMiU3@`QG5Lqen0RFF8cN7S3KvmPf`V*tvz)_bQH!5ie zZtPL#UWbujp})f+pUD}I4XLIVA0-ic#0Q63#9W|q_L*CCf+HTu-!%~vV@~Ab-)J$} zn!-Ew37JHKho^2}sA8k355pI$mUa;D>HcZjVgpeLq&0A5KVdRL%DZuZr>8>)JA;fI z?5|p4b)2nOe}+B$$Ife}bl4fp?^@*ddpTo`POL}uQ8zqLqVVed7e}bdSRF25Avn!v zywhAXC9vG+32#`29;!uH^FDY8kPcmaaP7lIE|eYOE&LR! zinMf`U86^2;Qh$`!mA3Fpqyu+{NEo=7&c8l8_jQn%V(cw#XU2|pZ}$YlZkVZwZ6@t z+-z;|eHI@UCh3Mlls49<67}&9RUGNLw=>kx@JIeBRfh3vHg^w2nqZmTRolzj#6Cgd z#N&zRe`KlpS`Ssbo2!mbIsq1kyUclI$hUe$K77{`!s9CF^po~H~E$UsCXQ4IVSX$tP$IB5iV-s7)M;dN{=M0rmKGm ztYQJCDKoXwPChu4_GHD8lOH)9>yLE~%i-m@MtLp@9bhKB0J&HAG)!B%tyaWj7s6nQ=V~(9#91hzl|fUllMq{^Q5!bxFLq z_vIZ?aRBeHuTSn^S|n*7heM_AmT0InbUh?#iu_n5`3p^@0i+70G{z2mA+g<{H&s_= z!OhVl-)I_$ACz92lJ8K)cV90as<|S85~)%C#^GA{hPWI&E%LX1*g?Xoj;1}I zpBUkW-I*lIKH_=hv+)ta&7d==zuvFf5|1rSXMAol$GHnX&;61kxKTV0f<7mkgND9q z=xCz@_6$?mI!hYhwtiHJAHm;Br>jx%W77oR_C&FMBKP<4?%m@?SEk60C;tnXOm~3G z+vT=}cB+{FjB}g!q#gcjta8mFc>VIF_$0937WUoUW)0G{Kwb)Q#<3&|l=#(Q6~$r& zm&Id8XVwz~2YZ$WlM=povXy*IDOM9yr>}qBz3m3aqEu7r2oK3d zyff=itSgpmYhScFy%Q=oHoWRS5joiQf9gg$UXb?USz6qzCv>E~6L@3q3;ijdK4yuU z;-TAlNiY00@!Sp7!}j-`pes?};H;!AOsA^G1|-?S{mi>cM{h*nN3GimU#ETW(9=|> zv1S)g?U}i>ourKByQ@aW6n$~#b*8}a*xg7r$)JxY_5j{*`(iltB_Z=0z2*ihAH2K~ ztgLZ*7fQ`I>K#oX<^i-{_r1*b1lKNZo%3DT{LZ}N2m^ovdqa-MtVcB~OGPp*I3CF6#7lnaiy7^(x?k6qQf2rsng0R?V%IRO+% z4x`bX^+uO7&vnk`+JRk!x~bMPH*lkO#!oqxNdN1$WAPl14L0{3G!ev{|P zvZ=I3c6R{?-`zi4^zkQ|JS`u0b)4|0`tm#%+)wmu$bEy21yXq4!SInGlOwh{shl#X zX8^^I5+ym=hA>xIeTLOmA9fvF-wKE^L#=PuZ<`T)KWJOxqZri&4)b?O^>M}!>quTW z`%wWaCbN^*v=&G^RIUd$xKpF<{^Nc}?(u``#mD_?mR4|nSWQJm*$gkllpHptc0v1w z%M$z7&EV2WseXHNd*IvgQsbhjK2n`ax<4u@hJR%%jN>jSWBGzwpWP!Pl#-tCx8k(~ zDTDgnxg!ktCvVFqyMxGsv-I^ZNGrpf7v;^5dv)Nr?)|`svr4#Bx7AF|E04;{gWuj} zsbgu^e?^5Bf=HK=B;2WMOz_)+`4@=uY)ip$x3qFK99dOUzI8}h@*y}qAaja(>wJ%(ZNR1%X_8oQNa3F z_PE-#Wzu(M&9mwD{E+;@m;Y9#Bs>UpaMj#3NKPHwetu?I6HC-Jp86OGVo&pi{pw>K z$g1{QxUy3S)*{+RjXoO^UI9wR8gUKuFkrW!dZ`0eZHy)p1mB#+_I1A}ab9B6uRfhr zriAv!y`EX}8zkA40BwV4UI^qoO6~6=2^0+F5jj+1(4dnfCt9q5!q;3%>1t#!jmBXy zqE;U+ou_th&KCuv^?^9%6g~XTWXOAWa7f*$RopDdVb5xoCNlSf-h zjF=F#%g@Eb9KZjfOK;kz1V=<4lJ8ULLuvpWBlT`W47}7A-$uNL;*$US&7Dv11)Qzc z{qmGi=^y>E;$|b{=o|E}Asd2PXUy@!|8&8Pn_7W8mxQNzVgn4_R8jE2d%OQEh+J=n zA0KnS2r%?TwJ8x^($`FLZc3&*A+N{GLWJn6xG3Ke4Llu=yBMxiO>hSjeA2Uinkue1 zVsza0=JYO9n<Z~Ot4h0gqDaqd8eg4h_=g5Su@SQtKRCdEvku z{ZYbl`60TH+i~kw{aJk&YL0t!=`KH{{hFm(dC824!wUBniTRP97vGUb)=q@a`^n6k zlf>Mr=W>JPh8OBaAMOA3(E!ZO&2L6#c!A8TwPW97z3^(IF|Y6+LmaERQ*KRopiwA+ zZ!?U9l%>h!7ZfhoW@x1IU#K;R8&4*L=2`+cJ55q@5M1Aj7q{c)%#f+T?ZL}7f}@gf z6KOc?fl_R&Vu`pvgGya@R~~f6B=#K5+6*g^ghycb+v!nEpHSQh^_@ z(mV@jJ!FVBl0gGHJw)D^NqF|rD+!qT+FSMGnHG$B-|%BUutIuMULz-WpLoBz>qgQM z`_v%wUQ1x&XnjI&4M`@Q` ztdEIcj!Dx>gXJ>$@5zuR1p`@>`@y&;kR%TW{#G@8ji-l`tSN<_bh`M#m&7MS@cK-e z6PEL5^`OPsEbG3sE~L3e2K<{5!$F6&A8!;iaS6CW1&!rkc}E7v_e6cD*R9OdZ=pu# zLk&6G=_c5l)BSsYI0O8mT?zR2%o5Uy>FmyP5&03>eU=S^CTO}p+iPk`3ofP1Hn@bc z!Njdnh8Owj_`I8aqGntJ>Z$u{eHGPUV%a|L^|T@S`5#!5n%h6fiYjS)hT~7lo!ZX{#^BgB-4NG zaT=WwT&`|xd&nk=d$py;#|D&<-#BCDWQ#5&l{_rUz5bUpwZ4l{V#y50&&NA{Y(6oFz@+*3_gla8;v(2 z&ZT2A?zf#Zq4^J0g#j}KzTU4fYx6)2hm;N9WHx$oyMBn-=fZTkJsdq*@;yY<(K zUymZDdhk@`jT*txM@czs8G`UAP9V70oer1sm_VmQuI)*dIfQBY(}!$oAu9E0 z#}NCw#2=GWCF7>BBOpzi;Wm*&%V-mND{YFGNs*3ITtp7y{!Fy+v@Wo?MQ(NcCkeKL z4HFBORB*rjO2J8+SyHr6>4DM#4cKz~%Ru@rhjtEb8j|W7=tw1zcHeG2d}jkDvvjyo`W z502{^0%n=E2j>|&!h7exqsobzL~cg*y3cYTmJiEpbxhj>iFEEV@EPEq$M~FGTM(GX zy7K}m+#$bEEQmqO6(`0g>ulf{)mc^@6nyfZO@nZv4J*YsSNJ$^CO_GWwRgo>~0+hQC& zpnR%=ZuOcgg!{z0$LkOr)hjYg68{JfoIji0BXk9-sk)@I@5~^q!cx1r!4X-D*gD$y zl_5QOXq$OUPr2( z$8?*#phEEG?}Xzrs5%%*U$EwnEZ2|eKRT#|ZG(e@#dLviBgpw^264X3N*%D}x$lKL zYfB8n)QmCdO0PG)sSXTg7H-9zA_2Xkbhb`7KRS3Nocy$+jc2M3J20Xw#1;63w^zwQ zLK(Yu>^mJSp*zg~fX4tF0z#WkaYzGmNXf^@Q(CC%*_|-HUjnv9^$nSKD8l`(yhl(* z3VRaqk1-puKYEZB6B^5o6sjzncbWMxE&F8-g*P)!o|ixAuObROk8-)Ub7kNi?@zag zzskrG%j31VVT^Qd{KEQ4+EDpG&d2Kw(bMcT^PIkHijv2akDX4Tgx6<(zmO3pa)NX# zJTEv%D6Om^N*k|>sczN=Z&a;e<1E87!zDFnH1%ooC;GGe3k$~S$|9({61T7IuO;De z?seO_$%-9?BjiOt65)f*Q@SfH54*0WwT;djK;|5>$+W3sH~mI^zMDAmau~-lu^GX8 zzRok68v>xL5@oh?%mnK>!{ckM*zrMp+XW+9Gx&9U;iGl&9Qn7=En$yj1HAn_-e>)` zG*GL^E_3{p1>Km2kP0a!-04>?Ua@C|oH(-@+2tz>gZZa_yLxfqKgnhqkz@^wy4&-+ z&O;SGH_haG5WO6WTMNmnsXCaKdSZdARst`EmnhJ+YC(95$zAGMMz~N?*~V8Xhn(D6 zzdGZelGo1Mw@B}j2N2QUxqw3?s*G7GmO@S3tsr!gN1fOsR=k$^HlzV}dZ%0q?-`?h zR%`Y0V=0`~$*hRyF@wT#ZH}TJG_cRUWMX%QIR-~G>XotZ0RK_p<=|i6R-p5_AOjo~NiId)5rB)HNx-5k4dHFFedwcZL!BpQ^efzF^q; zpiB3uG7LzOJErOh9xdHWtn$wT?#NF4{()JCJ1oh|zd3b33<~sb`NnoSU~o+PWVw3~ z^6~~w%%w;|>!Y5&eS?wkRo>I%ZV%ygoBKWg{6Q$T3>{HY|78!Bnpesab_64Z;dkMX zNl%#So)sQ`7YJT?`^@=dSL&r{DuA3>KmFr8*!_!}Gu?HUwE{Oc@0ZYhaBM z-R(o!9&lEGBKi6^1-LrWK3&6Zgm$fKtt zw~-AJjEeZcE%M9kfJ_UEH&?_h?|g^gK_|v?ZKtD!U$ZR~Yo~eLj9Y z(gx|NH&&(0)nNk|v(2qc@#`zZm* zfBn_yss`Mp9AZ0gSQZPbsOuE3%VO2%@ii77NpQ}nRt`DC53R>Dc`q=Dqg}$&d^5RL z^5BE=E$uZfkgVF5m3CYhKP!zE^Q6+j%-!ge$^{Xq@}$WcbJowB>GVM zS1TS6!>+3r*alU5rrDQGnQX9r~l5ioj5NX=Rnje;+x}eS$PAhpNd*`)Ng$;d`0ymo_#9 zFy^3TY)X*CKkKsAHyCWu;_vu|YoZ%^2-$DGZV3m+)r+!RdqSY)La)=8on|;R+I*C*ky(LSZMaAohME+*hy4R!vUXk>YyOfyJ(E34 zq=#TEdf%|*8+R-!k35C_7T`AJ`sAOE8;G}P{P7>zjndY!TQc8w;TlI$1jAVm*u3WQ z_BAmt5HekkImP9Lj*LZOevjRtxRptNiap@Qhp3<@t?4=}cyFSUk|PgxzwN4RnF z1v#5%Q52+8^=SQI+GgA@xA07LGpQBG?ixUJD#gcZUdTtAZZ7VcVVTo#37;WJJ*G7RCvZGrBU zaXoxsleMOiWQG~PU1MFjB*A+*pxWey4iuZ`&RudB!hrX;D=TC*ai8I7&I6OQ;NeiN z`{0>6z}3n6OoBfl5Fq#HPoW`pX0^XEbYukH7mrqNi(0_Fr>9TWF7SZ6$A`TN!dhth z%pqQFTorGXlC-pwwSepWJw**!Er=StVD<1i3$k)&zOhXp;Vb>?(j&$zq!ahtU-17k zhF_r!4Ro(8 zdo1yNWo!C33pFrh^)ssBPyz?1asM?2Wz4>3^3%Id7@vw9+d6txlITkhlVer6@fM>M zyUTHDjJrRYZ1__N1S}punR%)R(c2G?x=!feH<=_O(su)bhn?E{L5>6gnbgIFMP|T! zaBg&;f+@aDO!4n_C*en59icnUy5Of|KAqO21##&P_Pzijmr*r;DL9bkWC1s{O7PkbN>^P!@j*Cf;YCQA>ie^d7yJ}lbn5uadXDT2bHFdEUX>@WW0Q8 z;p1;#aN-lwJy`Dz6i=#l=rnmC`~BzyhJQgwYH^%$3ikw$*oGhEOh4qzRaYpm7lS)A z7PW@bqp41t?@Fa!CKcXIpBJkyjqga+JrWHFuSmp9X}d=(a>*mpU?S z`TQ|?qYM32)h5zaHei(e``m{{OO!~d>9yNMQwk$;7mSEys;6+>ghJ>06n)rER$GG00B9S-FR$?`kg~q^5ClBI08maWB z^5~lZ(#x}vPQG82V8BDU@IFZ%vv?C6f|Lb;>dhqG!BGtmjcNRrS5NpT7@g<;ljO!$ zuS{z-BMn%y;qBMdlY~%H$F-Nf+DLbu_wa(REUI(TB+)3Ffk1uiJreU8iRsjfj4k52 zT}&8sk<8-+#wQn7wk!+@AGff`!AN?z=hA(lY-g!V%*HTanzu_HH98zWfHG=HQM#`9rUZEbG!ksY;1qkmO>BJmYxXjUueg4ryy zOTZ?4#p#;DAmt!@HgH|uid7xXcBUG-_}E<@~^|Ci)PD+Bei zIXBpHv>{6N-}OzY4YFYvB=9#Vqd<)AXy!RF@aafDd`pgaUcY6H@Z2wrei1`=58jnU zaou5E^Ck^wZPj$3s#ApxMZYZfbJ{5Ck-_vzgYdRYIDeDk#CxRO>03l`CLILY zD;hkbQ31=GldlAhOCp{L3t%AlKqo4UHW=8oVau!bGWiz|pYrYHP&sj|;0yckwo@Hny4mR;`z;Q>b+V!bN3|iG`A}f8qZCHB?wB{V z)5Ra|8h3uV$$*zK^>yU|S!ktgD4J}PM}wJBvB9TQm@s>7_X@KdSc>$;Do&b04`=du zSAvs5RHG(ojV!UW43<@>q+r+V_uRBZJMbSkw*NSb0}Au%Jh`e#@M01O!%w0sW_Z}P zukLk+n-LS@hm~TW{7c#UuFi0jKj%Kuo9d58$;=~NM9zdOk`yoc*%J<#ut&J?g<}1y zU+Kd=&hWJLEj#TIAGDe_OWW^FWuzsz(p?F8@cuf$evN_{Yv zJ)3k6W3DY5-F zDvpHnVSbLq4R)2XYmytapv}>_!;$DCNw6xM92g~GdS}@4KZ)kB_E>1slbBChonIC4 zm*fHMf;Z3qE7XKcTZsV%UmnafE8qLULkI4~7WUrgQGxxn*X!gp|B+N~Hs4Z=Gr)lH zu2#Wq3*5MMHe;Ao7H#5opSj&@4ku?De(~57@57*FYbRO4yV-s&l{ieo1&Jj}{@bQ7 z-mJIpmz5cjXOsEqvZM*8sJ51(lx(2OoWqyq2*DdX5zJ!MZjGlBhFmY=D6H-`INyDFaE32=ndb{1qHo<0{%f^+#xLZ^+kpX-sCi%OS-2D5ft>I z(P3(MpN6W2>bNG3JWV?LTFn;X5&~cBPou_ntZ@wir_8WBWbQDX8wWHodbKlfn*u(m zE%GYl!CtrXDP>(+$ov%yopRZ+c$A|v^>Q+jpUR_N#K(76cde2F z6W_|z{m{UFpH1&|3rVAUqD$q^buM^D8aj+_#5s55=xnO zitLhDLr%P6fhLqIjSr)UbAoQ10!JW`d$Vi#7Jfnw{Ajx~D450Z*+8~iDT^|y!U2Wu z-^!p+`{?#p4wnwmg1m*t3+?&WtnnJkC5PK)pNmwmw*z7RDJ$eHzaP{Mc7z z-E(NC21q@3Ke?xn5p>m;?(!_DqJ?o(ghJsGDcgMALoiqtD$K~{kDf|m$>7Z5?fdKG zZwFI;=<ERd<_I-Ww-xO)UZ?`}XoDP6?qIWguVY z3t9AE2}umeRwDfGU0WQ#6~Vx6>S8O=V;!M!+e@)W70(x$s=vKz1SQO;bEO_@f>|8L zt6z^y@zYf)It?oY^i(by>}fRtkykX;LVty!>Pc?#u62E+ImE!o-Oi3Arty#MPI};D z9}stev`Ly-=Lzc{Rzml7>1Zc`ZL$~b=xk(x9HgAL-)GLi10LjqXOA}vVZQuEziO;3 zuG}p8)4RG#GL`;*?9@If2=Jtkx_DXuV)CvL_Y?PKSC)B#27Wr< zp+H~61joHQZz)D9gOJ8O&YfDUc5W6h{1biI@#p-}}M@zF(7uE2ZBDK4jq9=TG4vqUw^wg()4pt;sh9N}m zI7Y=r!bGW@6(P?Ms5)3?fBLmCP)( zSKd^rIwW-H(Ra5Qbw`&YFE2cLD2@3M1FCk0oT4t;%SF5!Q*Du;6y(V?K?ost5Sj*1D z_CbQ*8ruECOP2#;?zXZ?cu3;EpD7g%y#)7aK_W3BTmoKq|2Z;1^ylff9Dc@}Qo=9^ z;bR%;fECma%N?57;FW^crLW%_+fs)nbcn!Y`;{Flco8u@?4cUN5#JatO4-xx1gg)PkP^8PgX^jlkoiGf#_+ z76$Z4Ih-ohLFO(&kvkW(KyNH?#E{@aky;;=Y>ca8Pi>rsN`e@c*KswE*2}=BbvwJi zgCd|D_TvZjV-`#-QV`l(E{zHG;urpG38AJd@qIj~4%w-PQ+It*fVyn=hX%!(xS#3l z)|o9?RP+^c`1(fzj$Dp=$6755rY9bsUyk4amBak|GrBd zeJ^U=l2-@kydfQCUoEVqe*fQ@D=Nr(LNy?^MG4LppG&3J6@v5q7Y?D(On9X`Zot1loY`}8d{#4%-NxLvK z^`8kHtZf%Zas6B+Df^a;>+-FWC1lDK`5)Gkro?F4cI~9bF=O?=6ayQiD=$?%UX;Bh zy}EYz!1r-F%$igA^!~misOb1>xfk<+!@m52*fLpcrExnaG9iRJhY#64x6y!c1tXfT z&f-w_I;##Vm2oVYH^Pl1jT^%eG3DM?xTJW{^#5Gwn43;!Id-C$l^a}j?vxCCC=hGj zvt)@$Kc%P}69d3Ue?Yi0)(wh=ICPW^37*=!(7~IIL|#_@L2cq$;=O!@bHS;J$YXIw z{#?2r0Q@grS0q$upv!j{U!rovI?rYv3Z($Bj!X=GIqnF2tsONS0i)!E^vTf+j*NI) zrYgvg+YlUro*$k+%4{MdIG?8(QA}~san3KAsGj~$C!_>j>>&|U@=*X>o@HVwQ z8l2uYVDsA=OvFvcXu$wnziiFgTx=y*TrX1$kEKHc&m^atZA33$Qp@C=DAE5)7LPhb zaHm86N6~qQQ~kbiT=w33@4fdtx4p8nNhzxkB@HUlvYJFoQYjfJUxjdPs}!Y-WMyWA z5DHnp&+mVi>s;4)&hy;k{eHbwK4c7CH%GzYTV1-hI8gtK?Z5UodpO6;e~!=zY&&RZayNPHbbsScAb11!v@Nm?6;+e^PKQ_!Ec`M`}~{y;B;(G z1^<3O>Z~|#1Xm(HCM$iChV7tu77u%Z7oUuGEA9(IaH&G@?ruHUAbld=4m81YZzzI0 zUua8+@N=gXIaR15!>PVUobwDQo^^Z1!bJkahv-Y5A60>~iR*h+7uLwn{iyO8W|Z;M zUXLIb3q>4H*U)Lv1E9Y&!e4S<8kBcyGVKU=!H$axN*d8@Xw@Hq4q3J^8=k+dc|#wf zdUqSqFOu+#T>Re8cMUM)u3P-$cug1=TnPEBp$a>X9vpFSk-~iuW6GiOtK=xVHqyjJ z3Lu5;JJD0ej_mth70_Ie1jUnFy{nXJAW~Mut1V)T!M`IWyY{MLN9QReQ*9#ep+ANH z4{IrDL@z{@_N6JF*fYcPl}Q7ZKOZ#NY9|4U6ldlGqP~ip@?yR1sD)SCWr{fVi$dM` zTl4Y}I$-vG+nhIhiyZU(sZQBNGlV^tbAFD=!;g8mFsDW6JrwIM5A2u4tw$N<_h${U zBZOi3E8$BB5Ph$?a#00TWlA$IX=!55(6#&)F-cs6jrx$I^045gu@M=!PM&>tx6=76 zBYr2E6KXXsus*`vOfg6e8uT-gZ~R$s$G)2SoqvV!->6cwKPM+Vmw6>rqe}@n0k7VX z_R*p4=F{1xixP1DP=7g_$8VDIU4^gw^s@L|x$MY)?3PcJaZ9 zM**`tIw#+M(_7u3+Un5waAT>?Z^m8RLdwLph8jrClFI3^G5J)}~rg<4E|5=XUU zpft`;HSxL%xNb`x8le+IwQp>n4;4wHa8_qqM^ht7?`&o3R}B%cEe#hu=_U+~?QF{3 zLQ=SBQOGK-#6d)T{NVP~BXTfL9pa_g`bO656)1F+rGo5XIU0c?O0;HD*-K+7ixst- z7pz&_aNL#Y-(n5%?vnpAe!JiSA*cN<+79mmtJtQ?#}+kF`RBt*#zj{w)NE3ewA%~v zp~6$n8t!oPyGO`*OFx3wm|{6(tc#Y3VoB6%gwMavfU}_A9Fy##Wc;~yVX~ZMaqJes zc{q73P5&U_*NHhhJ9WkxseJ=>TXZ<#x9s84j9mR>~6dAl0_3C+d21 zAnwHas;;&T{MR{|*0CXgKCJOvbsu@LpXE_%Rkj^gt8vgcEJ>nnT}IeTAs1kfIurYi za|ar1US8!O^gTO@N(U@&QxkoMO7_U274WhQ9hO#6hqb)3&iO*tI7NG!@rbKBH13!Z z{@Y{<>p60NerFb2dLEkh+$}xbOfu35RSS>yVg&$;17q#HX5&#zsvrSAChLhH|Zys$<+rAj6as)nrBq_0$D!CWaa)MSCRav!^72 ze}dtYCo&Kn`l?k{QWG+K`F_Y`a$_#bYiwTmFhm=~mnDoOO z_!ZzimdX5pmo~rvK%ZvrQ`Q>{Pj5umcn*Ml)nmSIO$#o)7z_XrMIu(vcF!agrtP zRLre6T==BO>c&krZZw=c?M6Pw09yQ2Pwe}+fc*HSO-dCtrX|!+6x;BjR%)clOHB^Q zpS`;B$(tXQFOE(W9kqs&np}P-l{Jx(&X_;_r6V?~CWU1xTHvaDW&%4gpN*F`zJ1x7 z;M^QopJ#~JiFUh8?{xkkbV13fcgu)*t&fTCij;&UKCG^08mc68_8+UC_qb_e!;1rY zn?#N-C9m?Dk*heI;%%tZ^S43=4ssf;mK7WuuzE!2k7(VR9Q)4>DW3NomAGsJdro1G{G0_SKi#b_+9rzm9^L|34aQh^TwEsg z)fCCl@=@p72_s;=F1G$*kO%DSPZc#yyC4(Q2W@Y{=WsJu=YiB4YlsY8c}<(52mFDb z6JN7w;qWgtOZGAYj9L4X74M@7_Tmw5l|r3iLi{h)ei5QhdNV*8yJm}RbE@t$(mZ&h z``3Z?cvrZZm!ws(AOOG7MqVk+9%J^_^d#Ozp6k>Tsr2UQkgGj0r1OOVs^<26 z`#2~M=e~K^+YubzqhYjH9Eo`pcy(U2`ly0*Wz(b1{=_^_)qmWtRT}~?f7TQ<(?cQ2 zKsEPZdE9gI@nOru>crlu*Q|dhE#!%AK3I6BkMDfhzH|J3Ns@GBkE?v61-{gxXQ_5- zAQNx0y_c94T8sYqd#6(f4teVN236_9VN2Ee;=f{GWSFdZ?Y$|=A84~Y`AC|$*T1_n zhU&uk#^TPN;!Uyu|4!p4!HSsk)tX9_tOc=gkE~X^Y0#iRpLOlGD#lE+_RE*7k#-mS zNmUKegu$GP^7^imWS<0=n7{yaw8(oid&_Q?ln`KYk1j?7gpVu@$oJF1h_O5~TcaYH z2&`=d%Ss@l!&z=sEg=|8y?d)|f(c6Q*PKh86vV=-VIr)KlsFZ|N&BdJf$WpcI=vJt z4&0OJQAur#@FZ4JE#jsGT9JL;8x~N4Xl{e@Ve&tch-XN0Y=|;C))yL(7KDMzmNFGn z)F9fe_5510G_Gg|-p>dn=24Q%+xCP{vgoGVU}JV$`9O&WYnJ(b-pQB7_YIC7 z>)C=}ZC*upPFx(`NwxFOJ4+yaP;pzJb`?qYjl1nQi!5|yn;Xzi z1h>MyTH%9GpdY;6{eJmbq&IQ|QI@o(P+{@D|5Oz|{UUEX-m*Ntp#dsBtY`TcHBsXH zi`0OJPT;2`=3H^o5Y&G<{9(v33o!vvr_}d0vi_h-fPhpOei@7p4yRGnpU&)1hCJi(#Ox(2~ zybHdwr;|;G9HHv2TS?dvKjcX_{5BS)g$#G-z34V}Ll<({=1%HjTVCj%p))RcHr2Xe zOzIEm+vq)d!$A=^1-&Q(N>^AKE++HmEu-O zn|FCdg%1vspGsRcNrv;ofXDFboo(EZ!*b7?;w~{azt?11rAH0)wT! zW;p9l^UR2s3BzaBAOE<>izdt)ZW~&{!1+}!Pk)n!(2Wj4MY9}+M&4=_+$Q$wi|+RX zYUIJB?`~IMAthK{y7}FZ;F08v`KN|%@`IPLiQj?@Cpg^otdNeCMx7h0G4I1Da7Ll! z;tg6w*zhCQs=V7EAKk!yqxbUYG0oBHQzih4{^6A`+GN04I>7GIDmT7-d`9W?pbXk? zfB#^!!37-WdhPP4gy3cM+Ol;CC(0ha_b;K01~nNtvYwt0hmx0iaS_!kC%no5TlmoG{Dc%zN((g<6!Y-zM`?ebC+cInr0W_B*Vuu!q|AEN*Yy8+k&HKd3_!Xha^AL#3EwR3tQVcPLF=jE zR8>hcj8BZ)7`dPWnES7?C&vJ+-`};z^w_J4gHFKq zB%LPgsSf%#Z73#7xnYxDcuPvIIy`tG)|K%M2%ddjqRdkd^tzJu+=u8l&2^kPvRGZg zzJIwujWkI9{inpih{Y01+j~n-PDx?J`8laj;ykOr{GwfZNQKA?z^nHP=|C{)idNE5 zb?p4Uw=p(mCw?E7DGRsY!pIc2j}8M)u)L)=l*?@ZGWtgk3KRE+$F!sGljkOAwB)4W z6=w`1zsR_^hv3S1yT2R=F+$n-%$dUp5=f~Lbm$|ow~ViAQ5(IaiSC+w#MJ{C=BqqN22pdm_eeDtA~HL#u<-b&W3KBf(4h*!6U4_B=Om zs>h!d+ARVaQOUy`LsU@zsHTldP7XiBNQf%mO&(?fhMdve4GH!={g^|Mq; z7`2f3&FeEWH2QYZc+;rB`i0?>;U5LikU_JbH&Pc@)x+k4XgT46duvh?F`qDhwUDSJ zC5n6r=Y|YvcrlJWXxIF8G01NV45km6BGFfUuK6oU3-NhpWye$3NHNrln+=~Okm60o zjG{3I#2cO7dZaH1UoKXQIN3>J(x{JF{Y*XC-a~@>#SK}|SG@1BF)of;R}T5PD|2K1 z{!1;_npMHmH;3)jBRcHW9V>ZOER7O=Z(p626Cv_7PV2lE6D0D!86JhRs$#O+@e#>Z zPE29t6TDTf1aAlKMhD;Gf#J987VmD!VEirdd9}maT=yX0$a_V(14@L?ENGX#=woA0zS;Tp>O(6?Q1q<0 zzEcaYe{Ga?AoxrZ-<@hU64l@t`PoKvsM9hQSS)S^*V+G? z>=Y#CYkyTPiB>g}KGQ`j2V7SGdnzC57a!zt$58$LE)GL@e|6`NV;0t6-DcClIcSBq zH=8?~PMPCLzxPEEI{+T4{#=$isR83}J^ggf+hci6+LeOIVe-W)N6{d{Kjq9ZD{Jkf zj!t^6MefsFaD4mrd9P#x2>UPbwFKd(l{k9FoOkb&-`%3cE9}-Bg z(FC5RP#3PFjQBuvA)m8oh1{x=pP$=Hfxk*5sb6?$;&F*2!6Io&98LTzu%ks4E=pRI zT|H4kn((+=T<$N8juX=RNIi5oKvjBwen=ML?Hc6x+L^HWbm5hx{%<64s$X(K_xea* zbI+96|HqG>2V$%yXtv3%77oW_56Qw|d(QJM6xJAd;hsx^(x0wh!$uudg zK4zv|D9xWgrTCcz)JABH7;iR{=*2`k_zK0aweIkd%e&V}qUmD-iwj%iPUaEyn!8Le zH{r80pN<+l9F5E-_?S`cXv}@@PHG&xF3`p)yFjMCXZEaPh#M#`Px^_wbAkEcA`*+H zIJ)F3G5gqv;?4Ci@dzequxxirJb#}Z@o=#*(y)IeaeeQRDBAo%I-?p# z*%vuMX6%_RxliP0`4sY+o?Eg*;boTx>Xk;rYD-sWQKktA8Wrfu|cFlv9(U&F4WI$e);E< z7QR+JUEXlb1y)_JB^ul%-n%B9Bj(TgTT(mh- z@c9p^_hE{n^ga=6?Kb>w`%WF}mwfd;ezXQI`J5Hy%S2vY{XGiDKqqu~M^-d>D@f$m zYCa8FCvws|djFG7w86%0qdRB#e~>DqEHg}*)iC8zH{o{CKd|0V+Q;?x51q z2kYZ;;zEaA&`)yaMRheF-W8*CD>*`NH>sy4qzJ!)EZ;j#6CMSqt^J*T!&aHdWs<(F zsH1|VxAmD6?<>Nv`@Os8b>(5^>cigg9Ao@9bxk)b`4{uqDMFkHT)P3;E}G6Df*{`c1vmlN$W;L z0?5KwEq?Y&c|e}W?;DM8@xu7^E~hC^{1)6hj1dj6+Gz4Alj z&P0?X4l7)2U9{%FVvd7V-~XwDtahZGdCm&yy3O;Hi>w4Uz5m8BeX<}5Yli-rELDY< zvgdb2{o(2ZlQNo^& zKjlhkG;vsMGg{-0792WE^Ypi&B2XLhQFzBG;I_^Yosn#D{CKT=mw_M!aQ-}LAKxJd zsYM3ecSL@XSARa2ILax7J=Sl%Kcugb25BBX|4gw#`t~yH*9iR}Y3@mN%tH-M5S`og z`U9||p#99ZUZRfs#~7KYn@)l0*`8k~xg~(tQnT>NxD?FW#-?i8i{V?l9GUAgvba{h zTX(lK576D{WsL?)W=N=-9=BOQ>_cVJ2*>MGKN@sboTE=ZIy+i>%OLXcdr{C^H8 z&_(r2|FAf4>G&UE9aaE_6JgJ*b6g;D?eOiDot|i;`1aY?0VU)*^m|ye))vFX?~z6G zH1TI?QtRkl4{-Io;CK;ia9lP;Q8v{bHxy64UCB2DULm3OPgWb`()BZz7eZw~+v!pR zr#zwmdOtZZ5MzTGey>P##Q$NiVQXwBc!0;5D*_+g7RNp9f{f3`?9fU!T_wuN9R6i; z!Z*X|VY?%YXX=j$(h<@U8C7b7;1Tie~5M_*R)BpnP;`Ag}V;M=Z}exaWS3@EDKJm8=LW1XuKauiZH@@F<9U{MDXT-oUq zyiK7&?^)X(GgVm8w3L|VC;X==lUI|%j4@*&-}6be4Gf1hmw(75f&ayVTQ1CI_*d6M zlG2gzSKTi36t3q2x{vaQ&WscHOYt}1y^qxKrqx)pg{%dJO#e`sLnq4L(NrnNuAvix7S16`}rw1G~PEUuwis?8v(c4Y+in%h{cn-&WX0 zv1tNsVt_` z<|H+B$bg&u8L9Ir>fp<<6!-8LAD$2Y)y%s?1DC%_oJs850d0J@J(7vNPpe!>e4UCU z=9TY?kMU~@ z><}i!8eJAn)A^ed#Oao#HcS+}%C-fK$2^d)-l*dKg&^e#`> zYeF}&>**gxnHxVzLR@njfA%my@YZjQtmRpTlK`Jzq4+j|r66`C;zAZe}YYbs(WHGhVCLsPaH~rQw8?*7VM=z~froBi zI#ktRgYnH(*GA$AUc}#y$d-3n_{2uoT&Hi2RK?I!a#&21&@n}j#r0JQU#Iu7)P^Wb z9KS7`(kqQO6CbZDAJM=c*9_yHvT5QgwTH?7saZhN@jvY1eA>u2)WCS2-;CJ5aE0bZ z6Fh4D5j`vvg0T38{MjF_=n^Ei>h5F@DqFUeIp-~iOpfQzR3-_10Zl_(Krj{ZGH#!5 zrY886ja8v**2Cl<{QhV7c)0OcK$eK8p9<#x>*I0jk_4t@)#JZb)WF24rmg0OCJbK@ zcG~7L#SONl^B*%AFnCz0lzCMS{#^ZDCvjaI`i;d#w+`}R)JV=&h^Gdg7Z=^$@sR>O z?AF@sUJ?Gf4|fjfyf*{>c;?@?)l@*waLDk&CT!AC9q7O$%z_hP?~ccDH;eWo4u zB>c`imVz(h`-sowkXI7XY=EhD|7EWY5xH76`|q9W*Ms<~neEq_8|1aTn0L-3Gi2J$ zu=7TpHaPA)B9NqE1VhCU4U>fIwk?rYMtz?QF860;b{r=3bnZnpN%j12-2CBc1-&}v z>u+3=x8T9saYY09Bqm6s+R6Gbh6i$O=guu#%E2oAl!{BIDz;zQRsTv%4i7U&iKxU8 zKDKk!lpLYN9^uoHikE~MQWolGT@vI+@)Pw+voUc{;1*H6di^(0`nhcyNfipC zWZaXkiQp^q7mL0Y5`>@ZL#63oE)bV3?D|&400$&kTFROw@o3hElfK66aA2&QxuS#* z$ilTZ@`VMlg;X+rFN_oK4Kur|#d3nuV^5Bk4=Eu-^6H?*nJ4Rc zP7!xps&}dQt%7TcA9y_@#el(u;;-j_#C~2?()ifFOHovR3zUR3rKO^E)qaja1pDxr+VTyd70LKuS$*u zx_jL>{%NRY`Pgdlka6=NlKG}YZN=zE!$5JZ2102D6-`yv4<(%-1IQK^h9f3cS3H)|4hG>QI zb)h0|%r4W^<*6`*y9u8LjuZUAJ0v%{Ha`=5?^YC*k--7BFGc+-yRE>~iBs~Wu?3E9 zGFjCy*kGK@^or1;8PJC9a=ykSi~Dk&CsvQCV#&Jkv4S!Zv<#2ro*L1B;Qxf2D0->U zENF3ipS>K`{775SmXim*E`~H~AwdY+?O6JTNgeyEzAoI>Aan)oe`Vb#L{V8PNXs$K z9M(6HZ~Pj3 zp2))9XXZyg8)y(b!ft-0C_Sk5-laYJ*$^D}kF(fz0tV|Jm2UXRgJ}Xx+$j>8aM3A@ zdtz4&DevKRU4~EExcu=)Z*hVmWd8aSut}u>hLdL0hh^mPbF9FHVsRx5>&xo)Ow<6Y zA7`#l0}rfp*B!g>XoyA~fqnZ=3Sqp%o%!6ix?t_=65N@&16(8975ex!kzYo&v{sxI znM}+V0_z09=d6<*J-;fr{ApRQ{@qNPeI$HZaIYTzjlFU*dx-;V29GNRr)$HBve6*s zM-!yYe;TY3{RTL8L^yrUk?=QCIu5A&C_+bA*W;E=9xUwQm}TCVNj~*hPuAfmJJ6++ zRQv@NWDGTZaO}AVl)eh5{B9)xjcoB1RU!np`Qc_2RS^rSj5~$=15Jofd3QTVt&zm` z@k-rNH#dIbHJQBDuuNvV60!2rVw0@l|KqxduK=7&J9^=lsT>Se7cz31$>FW~06EuT zV&B_NA6oxH5`NtI7MD>%aIDG4B%8&FxipFY#I-n8TnTMSFg?c)5#Eo34h#}~W_NPc znagZwAIG=d8L5sE29cbv|8PM}UF!J9DRp3V-_m~<%8Isnt_sKM?!J+J`*g)hIC?AR`KTUPH5KffCq$E%fRaFD8st)_Q3xV}aa-*Y>q{8-lZ*_tdp@ z9(-<=%(h=p6Z`8!sYTQ@aOX~1I@)Y`jLz50>|HT|v@S{U%YKv~^+Kd1#LEo_JAKZ? z^2uV|LA<`)ua5g|8_CRi&&}<0&cpuV}CHRE{9NlL!l=E;0nK z8*VBq#JwcZmy(jIX@xo!mIk&BR*)}F$L5%(gU7F^zO88n|DL_CePIgO>2F!>)0DvGNnG={ zX9Op;HGibwGB?sjS-HL@*+8Iq`{Eg8M*Md0sw9=QE@siNU%!{e4fmC3=WY-_TlF3F zA54|SG21IeeDWV7YJFF_oqSjfj_m5%?@83Tq|x#`Rx`SA6%&sGdZ7#w_3 z(>+lh&UzZe-C)s!f&KJGX6!1&KFQDa%nf;rbZ9MvfTg4tA`ap`Yq@ z5QKqpW|p<*{iH+P2X~mgTPFCyuSJ*|>ENktsky~1YWx>6f1rYglF$K}&GDEB1BWY* zpZrTPl-}jH+#AJ;e3v|W9ZetnQ-X`NI>zxUW#j|H;yoy*y; znAlPL#V3we982VzG4*Gvh1W@TR?-1`Y!^wf1&PXiaztI>xW_6=ahW{I&28CGCos!itQbCgGha{Gdr099O zE9%;tr0Nijm=2FjGY-MQOke1G1j5Z4CC4^jb)L;x}o3Yf2iYh zvDVqlix%kn^?>O(6AAP-?j$vNT0oqj%GdLZfLES0$!U3!a7C@s&+35&d~$5#JXj+O zH!bgrSp6};d791oFC)bMvb!Lfu3ZI6cZVF#oYz6|kg&qpC~54K&S(zQQ39VIYWvi-aaD#q4iVqlZ6;Mf>+#E zd2G}IJaoeDC>%D%!M`r~r-WtjZ_wwkS4_GvHU4N_rx5h1+-bNGWSujDs`?dz&-y`HVTS1Q+Ze02Cv)VA&+$m&E z%!eGCuIQ}I0X=SEy5&f5wa3M}w_*{$nF@1aq8A_sBxW2UC`p33TAm5p}iCRTj0pax>Up zvLU=`W8I-8014%miu4r>NV)DBa$vlh^iA8$bY?Ff+}qPSp?qbVTo+hts!Jz~GVk6B zCf16>qO{*xmgG6ooX1nks{4|7c97IpVZecW`@dM`k8{DT8l~`H8di{JiRq;Ixk;Y< z?$olly-qIDun4$T#f02-{mkDC=SXdmhE_W%gh9@#)FN zy3NEqr`ol6ev;r`M}HYR5iAHfOt&nueyBm6J#8#_wYo3dS`25dmERx>$w1lsJCEH&{bZJ>Y%UD+nBAv)O+r`* zT4^VTRj1e?vh{{MBbO8&3+=0CQ@%=?R{0d<;`NUl?f5sw=-E#aX+(%s)aN((snYUP zTP_!BZQNP@%-%~nWwURRnpPMZUf$XLH=6>FHpM!wk=0Qr>#=RujV|(+#u&X5fAt7I zeY+yHD-TjI9HR=VmR{Im1%mr#j0vhBX?&yJrt(B+M;X5OU< zvW2g)MzS?G43|}KOF7d(+FJ)k-oXXZ>%X#(kD1MrKGPUKQ6q6-#=wEfHy1gPOTQu% zeF!dIX`6N(jU>#}E*FX3ltDTpj~YGX!5Kv-_7jo(Ae&IB?7o)@>`#QhKmB-#JnnFT zd2fy|s?%pzd(Ti29I}%5`~h*0VEDiwI=f8v&bQAFvk^q=T`qsU`6tLtO}Z--#O;O`tFI-PK|cI)kM?gZg0JV57F(u@KPRYW#v4S?m8B-l!<-Ws zjoR^ruOhrXyyndjEP;=?1eV{cPm#_Iwee9Fa=_D()bBB5S*V}!8ojwk8m~kq*VL5} zxl7N=d?*LB!EUtT*bK`u`8F?&t?p?vv^vvEy0dSM{DI_TM3x}lTjjAF>b-*Kr#b&( zHHw?y&edGGBOwmw`DW#8%Xy)De(l@eqnAidS!{j>sfm4!>YXzdr46Kj?w@n?gpOX~ z={r8BUn`^%t=8OKkwpIFcNZ%Pbxw>nN_w;%M(hO)MH1KcNP)GQt&BOdE(TPz*#zw7 zL)9p)%gVR3VUP7@#<&PCSXeq|Nss6d+{uab-o4zo%SJE$6qOQC=sgh)li_*$Z6di6ywERr`EH~p$ZC7@23 z#ggyR6Y^XCf77|M0=QtmtNQ2HU*vR4xd#$YguwNIgH6MGY78m%a(I8A51$6y<31e3 zhqb0&;rxW2=~f3Z+$AX8dvIIeJBa157Yns zNBf6#awm@ry}lGq?E6*x<|YqHjca{~-6ahF_Lk@dr#9UmLwo+voae}mv+JNj2did(ZI)%+DH&TU;VxN;(wOl6H{ z8ei;vsZ7kIUZuDbWRbRrVR$xB0UaHD#CyXnA>>Hj+si_NI43LJtlq^^S`sLxKxDDr#Zpx<~vQi8JTfGQickKMxxKq7RW-Rm*sRv zrZ6}jDP@_@;=$&wZ)InHP-AM3(4SFCWl*{^zVNG93i(IBC5{|a#qKpTh42%E?~pd> z>>+bW4A~cBwtJT*Jh&2O^w&TSEVzoPcCjfUZT7HWwy7x&7IcJNPtbs!11D?vcUi-} zD3_7FsE!BQHHs>-%(1bTdgsBr9Pr6(ICL*D*Yo{j@b|)7f+J7KF+C(o=!$opE=@5a z>fk`3#eYk>aM0|T*zcVzcxC8uc&ES|+0^t;8E?}zS=9GGmJ`NWP?qhHn_D_ezVj%3 z!>T|Tt2JwCqBrTl(QkL+D}saZ_Iuns?%ztFwfnhVflj6u7*!V%PfE$u7`JEqpB~I`YGP5cvevlQKx$i1}Rzjt7m5jrg zta#vS+7N>e;afkVKC{$aKxTe#u3*DJ^cUJ9|EU!+L(?Dsxe{v)pw2m%(xS|Rjj|Tm zDR(u{vtIL=xfUnHMYC@(q=-Y}ISH=odaQUMCv`O-td|@m;q$Y}RtTBni(j9o=fHx~ zZ&UAt$pBMou-)SlMv%JWlr^g!f}jNm=R z_vFya&W%~=OXP^=f*ZGdyGgSCugzYwv0;qzYF{D!CV5CyY2RL60pQvAZ1UcM3S0*o zhAz_zV(A_OPo1x;WCv=LJ1)x%p>GE2>`Le$db!S~R&kpwBDPpXyF?F47Yb>j2A0V8 zE_lEEEUFCJ0^3sW)b!EJqVV3>7Xef}mt$J2tdE6vgjog}#o_PVw^j2_f^*g=BU>&i z4aIWCQI6uSNd53nx@{^kzx&eW`i;1s4-Rp-ClLF*{FSAKczPQ=-?ir-|6d~z&wPI9 z#k>rjoY<+_*y8or_yY}Gl3o({Zf6BCLVKMzyQ%StFYEJ1 zE9xjM+EOyu?G)d>7pIU|9(FW9sC~ax!^%?ts4E$ z41SVQN8teG97{TRBA0xdM^r-=ZU;5=6TTsUMC{_cf z6aOe>n6si0TlV#`b!{Nq2}HSyGQq3vF59jt9Rla_GxN&WZ}Nr9xT^D!1NMl&j_YU; z#qB|b$C*jAu*vq{`KwaWurMS#e?^l8XVT;CUz}hk^vh+=Uc-FwqUyh4{y7d%m~$u{ zgH_TmCG7_xwZ#0P<0@IWodY=d8g6y{Y$EZb)TW-yV1b9cnOpmBO94&!#Zc^!$K!4< zV&ewY@xiU(cRULk;4e4A^*K})zV%+D6-`vc4nuwUHc!HbNY+kzsw@KL#RdDfxENu> z|6(4=gdMwN6L&VS^TBbyl1sxm^w|AD-=Div8U?l=l*$vj0Y(L_*{3;l;Js;c{FjC{ zTG9@8yEm|bu|u}{*^ly&Ws=W&a#9#C{xoiD7^g<*{$-VVZgyxTg+6YX9w$HP);q_N z{D))`RQhvSeFvcrN~ZnqdLPN=qMhhNVm`IR^hDxv`#8y1`BP|j!+Wx%dMF=@*gQ$# zT@feU3=0$*MUZ`RMo7x5m&T0`Qe&_4rsvy!cHHfnDdKsO2Xc6y@3#r$fe3mlxm}4| zi1Aigc3(Hh!P8~;4-xl?L0kE!w!vSdkMiFOjx`c>eR`B7^_Ma7gr+TJpqB#P5*}it z=Hi95jIWQv_6q}*GwiNx z;NO02if5Z|?DLYfgOlT3om3`7KFKmk!<^7rT@3eba3uPdRWIQ$tfJLS?QZDUVfcurf1#?5t{nKEKvfo{jQiP*=!Fy`3^d-ZBR~ zIL8e`B5#u7q>b?JWLZol68_34i#}}y4Y+JxHL8MAxF%BmPWXg6diG4FzJ4VIr=$eS zJq>0_F3I9rfehNXFgD{iSjU3y{jwrAc~l|OoAu3^N@<9bY4UMP7ROel>{DtCRH%Kn zvZ(X73>?e7zisKF0uz$YY(iLwcXrI@Lir~i=!lYSU)JM*pZCYyw_-)WGhiR>og17e zu9j!lIM7QnNeGP79uvhQzfWH{vMkbdW6Z{#GEe zLd1(8_27C9s8xECRp?ER$)}Bd^SNa3-;Rn=>!B4AnL5+-P>dw#9zSpKc!CF`i=6gN z7093k*LzXU_YzR8a_~TotTvc9-|SQQCygqR#|!7*Dq@~&E47Xw2O!Inh%Ori*xQiB z&BQ_vA`6120@&oy<%nAc`!OkeqMQxm>ILFU+^*B@o!*I$)~KGwv2 zu|C1t@jwhqe68YccZ=b7D%GmzY^-o&<%-z1d%|FydN*h8jv!W;Q3|#3F(G5u#U6tI z1{gS@!>Im0iq69ktM`q=_TGE*+ADixohKnXS!GtrN>N`#DMB(sNV4~8*{g9LM99c2 zGkaw3J$~o+7rfMYUgx>*>vMgm4-s8izXyFWBv|f~^Fi{$G3wDV_t|QT5EedLKVTvw zggqY>bG!RV!6T!bf}DK{z%8{D8+DNmhUdDx%l=Fbiv)1htU~yJ)$R$&i$*H&gl3Vk zlza>A^)(Xu?fMrX9k^|Hfs_^c{y5*dT6l^u7_H{sE#m-0RxMjbwHz?A{>DtV3N2h8 z(b#z~hI#0c{H4+UUF35?mg$fQ4o)8J-=|Tefv;JHbx)2kpOWfFtJbC!RE^(0^w12O zv-5Nm(cYLrioPf~*2J%)UnXC>kACF=gVq*NZU#zFQK-r{q)GwEt&eKXhA3j5spIWQ zZ+_7G!Gh*H_U~W!+ui!f10l$6w)v~=&IM3G`_6DBN)mXDX5q76I}cypx3eX26aXe} z$^DUr?4ao{*|)J0C zaG{z-Tzv{3<+JUMHR_(u($V9^QZ zKM@!vRHwi}&kTu6q$Yl0&&7Of!bAc|0m}R&gWV)#9FfQ$*|Y7V2O^It-urc9bCuy$ zd0wpVjYL9|PSchV9@-?KH3wW^Q!nhz-)$23Q_qlcX+a)bJuTrMDgWY@j{Nq1xLtcv3 z>Mj*ta5c^_SyNIFJf5P`(sdMoKaWJU=K`o99CW-gS1t?$*eZKPoEU&NpQ6$O{53R` zEO@p#fd|?S)UC2ncOnn7^K4neF@IUmy_|Q^VOU+2gNEpDtVh+F=|??{9RF*2*k9Z*uOG32tRG(3J+MTqEGruaSwUnQMd$s z9FT!F=<}8pA$IujqOW(xITi5wO0NPZ^#xE5RKYkO#;rez9r#&I4d=IM0bNr9VCmb_9B`*2HID=C=%>dS6|C^9CiP3MktstI>l$ zmmD)Fd38YLa-j7k4~!es`XVmEs|zW0OvP*Hwc%&Ju3_SEO;FCbQN_K;3%2SW$yc}` z(ADD=T_VQ?xZzk4OZG$sbmtJ~?f%vTtDkPjUSiONm3*ykvLs6Iq3L??F1{|njZyaV zXUPMAOF4>4xB!#4^^U`1sbDvAuJhq9Nq`oHNZEek0%pdF8}Wzou<^eEhwL3ukllrs zooXNfw8;hRm@bH6bDJePLr+0azL78FgL%h$^=}e1e#iQif2J(g$(+ahLLbB;Z^(dv z3h!>uV}3XlJ=Y|EBn^En4wy5;2hm>xzrt$kWdOO1(YC^^7Q{@@i`b|H2i*diyj+wx zp%x#Pva~8TN2<8kcceiJ_HB%tNyez5pznq!`2`;EY#!ma`TZU3>T2-Sua<$b4}{0b zl`&56K|w$Y_PN9Zx_{)qref2a4E0m49 z>&29T4;TXLHm|WUfs)Sw`j*+0;4OY63yWAg`a;q6`ZwDt#8X^J`^ra7ApCt2&ncc5 z+I8IOv&Z^d%FV{g1)Dd-}dC;HvgF=3Cu#a8O9##Ho)QPIzB$ z$!*}pdiQiSgO1Bkl>6RNB9<$l=uN)38NZHf?OXV;emX*rx9;{>#MGd6w~a=ry~w}? zwGMuTPgJ0KFzrLbWm*_?wx?n~l=jk z8bic@64ttu^)RVq1yMd5CcQU;^&dx7tGHtOB3x%g^EoV^h_jB4B6?^5ySRA{iW`++ zbzeUxZ^>UolU4h6&KM1N{f))^{N=#Po@f+MNdyy!bgkYbX= zQRs)wtI6H)WA(+=#ESs3@bGI98GP{W z${Pdf4oO&HKpQ%N^>AFNwyxb;5(h#O7)^(Lo^#c~Ur`}t$aE`UTA7R)o{Ho)CcG5~ zyVDC!r=MxTC7stZJ;@3XeVir1&Oi+wypm*8lotaZyfnJcqRC-rAAEb#D+VPhw$G;6 zagbr+tJ7#yFLF}kTEr_T0@06?=1+xWfXJA{#iOUPK(~X^me~csC&b^~&~Z^1a$)KD zu811=(^2-K5T6+^$aSshd>4R?Q{!WC`1o+hPT6+o11a=w^RE)|BEtF{yarcB=|RJT zl}9@dxq$mD>j&96LCEY7YAbz03-8uiDHmb=(_AJ|uBBb%kiQfW8O5<<9+&9sE00Hz z#pg`rHCBA!Tbx3AyJ|TCe;kMa;lGCpWC5;sb?N(FEAao0Y1 zCJ8PJ#GVy=`Hk$z=Ek5`1mT(g58(sS5j4Ktj7@h&6qseKaU7M7po0f~KctM=p`H;< zXrc)@I8GDOD*H$c*e_S8aAh2zIZ6J4FUq!&Kenetjvw$LbKTg%crY8Z|8QwVmWvs5 z>+MJW;yXhq=caGp$Y+GD;9}Yu@ivk_<(E>{J%AiM`InS5vxS5e={`{=BnJ4hHQA5M zi9qDLm<@uPoRA^)sBh#m1KjAHkb4EO9`6J5YfQ8l=TKp$TrhcxHV%*YHrUg_HXikv z`&6^Y6L-Hy<3hg?j(_xw5gC=J?p#!1oaH`xx}}yocx4yeYz((8-4FqLv$VG@Ls=o3 zTKMqkH({t0-ZLcWg1zU2c>N~bl7RiEwm-%27m>5I?^Y3?4S?$MD!E`AJ9G=QK8Tyu zhnN3JlC2*xgO{Hi@i}x&0d6oUwLo73Zua0tFJrzx3O52)?^tc{vtI}Z1eSADtTmqtEG4RT^A|zW=xmnbNfNw{Ys>`hBK{|;; z_&E0b3^?NY!(+7I&C z{TPiJE(THfk4m6D`^_2J+9$K2t@J>JhOsm_6bB{wAH>W~Fu>3?BcU7b z`GIBrC3X+YKd+`X*cQ9b56R`6a>B1kL)RbS>sejIu*fF=F|&va=;P;Zp?7A2acbdD zF~1@#pUpfS!uHYGN-=7^$OdxNi(!96gBmOirZlE%a)ZQm+@C2+N*I&RS^d=q4>oTQ zDfg670xOFP2bP8;u+E{`$$|dK11eSjbeZI`1v4n`ki{$ZRp8I?wl!%~j z4GFbwF5G#(gFc`cChLo$hwt6R-KZ+EW=>tp-*b3%Pq1{#!+(N@SI zfRH`<;}iPxz<6iLe6vapjuVnh4`be(!i0vo$R@0()61ZMA&wK+wf;BqBJVtW&@LJJ zCsYn(zpz~Rn{*xkDXPCFNeHYBl5(^n5`^WvK{J`{GL-QOHX^s}#en2=EI#BNCx3aEKE$-V9cQZlqs`4*CyJ&g&OM?$xS+=hD$8 zar|5$P$%w$0o$yKr#zN)v%$d)?xKepwhhetp@a2j!8&J!EgO-s&4R?+pzFfpWBRk&nUzVpEe_pQ<4O>(WVR`p$8~ zTTiU#LyY8rOwG5sn|FVqWey#SItRS)jt^}C+g>}$L{jyeG=T<~bDz)3UOzy#VqrsO zPzx%iwk%tx$pGC(H8dWOGr#}>U!18J57^`>(zd4H1bAbLOc%0*VBEGy*1``_n1ztg zIdO3S{_V9NeLj)^8{Afy<`KjEP)oW$7lq*)=ZN#!Tm0bXh5R#pZBDQ-qlq6RDh~N8 z#PAL;?I7E)<;#9sh=H&84Enx2`0(yyH@3UV;*chxd^u&64Gd`s8YEp|1^vF~YE=<> zxcTcTAMNfkYGh?j)04G>1{Q61t#xf9%kPBg0&Vet+ijJFWk3U3NMcqF5{8i*1&RB; zEYs*!oKO9B(;wtxSLpS(p(Nnq>)sENe6;ZXA8uI}pH1|Ikxr0l7aw48rap?g&jKrF z%QSK=>EJCl_vT9}B!Kb{S;cLZW2C@$u+X#vAIAAhKTS8uLy5ON=a`b}+ zQ7w|?==?2=+cwOfh<$Q|hJIo45%nSgsfsbhZ6u`dB6?o;$$$*}d@NzSK_>{G-cRKE zlOhD9J~B$Z)KCIyqQyU49}@tYi+0U|MT)S6r&UBDP!V`sO4p|9JVdq2e&xMr(uJ_O zea1pm1%7dUwLsZu2+mg(o@Z&s?qQTEtF%sHu&r^nFN{(h+)+>Bs~p05(!I`&4Ts3W z=W6wTzVnj9Phv2g<*GOsd|PI39?1l6W$vck!#L@j!)vKY7^i39B@Gq|Gh1hFg6qONKHmC5tuN-n-Xy;3CaA>P|eXo>O=@=HGOFWist}lSFU@T zgeWBYt-{@_&IY(GE!uAK^MknbMM2+=b!7HbkoZJ+2$>xSD0R(WK}hFtrjFVy(9HeM zTvFBs63P7Swg$#U(UL{`kLdD4sq~l+^;v8%pip|GGgA;Oq-oP*-#H*N_rHo0R0wkN z^`pxe?-b3k-?;Wo2%HmapW+TA0UupIKI6E24#q`+69{P_ql(&)9hPh8zjthK_>ve( zPuRH5T3{ZbL1WU$N(#_=<9d;z9zKY8-({z)PXP9$tLJt#DB*@p@GU)SHt?ddiaUU1 z9cddG(=__Y0EaO>HwiX3c{{-Og^Gy;@U`oI`1OPh{%#KxOvk>T{@rt-3CDU@pA14t z%`Gx0mF3MWkVFK0N=y?g59g538&_6IN|>N1x0fda1`6UcxhAiQ7b8oq_s%}t>O%|s zR_4JGJ$|34lc)6MpzN6Z_nrU~8RCUVm-Fw3b zJe?z_p6Jj)HKqTsqaX{dZUi;Em5GC~^7HA9tP=2re@yEf#s!e==@G2G#E0mOH^OmG zC1E^CQvg4aFzoZFjKpiie2xY>+E^+YJn&$!{g9^$W8>`o%*15j-QajWzZp$%WiaiU zGq)1-UEU71O}+rNELF%qNhyM?+&G?wG+Ce!dnxjOM-AqAI5Wv%^Vg;l`Dpvc@}NG^ z+~A!pC3x0n)Q#I#fP<7KTCeyIkZZB=fy~}YfKQ$(|38!SAipw#Oa3w=G|tN)&DCav zivM+n7-^n^HWcgJ%lOzlw0`%?!7|q4K&ZDa!G?o$RyubLv=yM$IR;6aLt(&9bmtX} zmjQD-1(zBvy!9Uc~ zUSQvoBdy&Y2aB8lk=nlUR8$t=uNp~RdCUQu!ze<;H>6=+B2Y=b!3$PR>zbI-Nuaw$ zikgcW##O$H@3l_kh1A~QP)n5$2=@Na8L2x!#_p{dUkYP{)xKSKo8|@KtuH_Sm_$+o zhcVIM5DHqjXjHd2_?;jA3U`LvENtK?V&=XFAulN3VYAEL6@p$d>Su{PtkAS6|9)F3 z)(7P6^{daH49@VjFa){d;J8Xo`BwN5I)8gYELoope2Z0Rx5jw7Q{~s1`a%DY(%nLa zB0Uc9-aUpS>T!f(7OPZ9ijvjd0cgCNXZ6jeJg_mD+P(Z#*GRhQPjL=(BLG$rTW`I8Nzm9QD zz$hqfIxd(Idg47QGxEanM3u%>p$t@jgVS~VBj){on0~GztECEgwpVzbCzc-O9+?qZ zNRmMU7G~L4H!@7aTYqiuJsyZWD0!sz=m0e&JncGWB!L;bR`^F&{IDzU=~(`KQP8e` zxqFpL4$CVNbZQwefJkq@Pq76eKcHk+W8ZB43sb;69A()LF0(^QKkiqT@(|3M_3n=S zG&@WwF1TrS{v2Fj(IX_r7XcP+_tif0;y`wI`ponxKm2(`k@(viZ13OUS00Labw@_~ zh(EmRLCBe%y(+NxkIWl7kSebqy+Zr#c9kR>Hn;Yooc0rhntTC)iC8YcM61MV`8g6#ygT(_$~M{nQOh()~GXPTHdJK~eRq5)^twR`(3^ z#q-Hq)U0nSfKwx#z`l=5=g2H5D0QcJ@&FMG45BtQCI@}rOggkM|FLUV zjH~c09rTen3+@eKhe`K%wRkxhfo7PsWO5!85Y^rvQ2kYfR#*lXG87jvE<-H+Jc8G86&BGCa4?Z&# zr)?&3fQUuc$V*v7!02@feqP3hdX9razGt?qV zt3l<#|THTdr6?NE%#HYd(Czw2xTt-sM<|qy#-J{Ga@r znLrzz(@B{fB{0`JRnHD$f*Bve6$5+tz}w+Am-h}V@Xg)FLsFjwK|?l$p)r=H{L5JJ zDO!>R{(8k{bgq{Hu{EVa_WCP1*Vh^gjC1CJ((MJ{y-DuG4SYjoO zBsh$oy)tlv2-aHFvByEGJa10_Ir)E9qI7`MY+p7 zkErRv*%MP~fxk@9Qh{Wt0^>eU7amqQUSfbY$pqn=0c%LkL28Dy&?Xve5i$Fk4$Es0 zc)Y8a-bIyXW28of_Rzli)N|w)8R54C@M^RU4;03d4p3cV1`lr)U3CbigPY%PHcS0S z0F`c4>}FPtp{1u$i>k7}kX(LV%gV!kB$kfmF5474B5PtQQcn?m26hf-0yb!= zCoIcd{1rK-y0GPf-SfZur2Ef)*hO)3-e-yI^l&kv{jVGAH0q|9OgY$24XzJt)@Ch{ zz$Ky?rTBG^J#J+6sD;2j=?6{!)4Pj1Clph|`@e^d-KSGNI1a98CvWfI7 z`vki=$zk4g2WOg8e)um`rmB$>0eKI_s@|rt!fdR;ne+2Sn0Pw8%#kGtTtCI$>$1cA zIj(XP?Y%hI$NrA9M4AMAj#ri5z`jr2S?F$WVtc{h@p?nw;f`b z69mmqGeQ0zmicdm3@@}J}+!og6~j*vBI{jfqqeF`mmfqgjW2qv<&>lU>tpaiU5dq24#)X$O2k@{#2U#%+QIpNay}r zQJ6Drub8z&1|7vu`*$%PW2X<*4*hijuu0F)J8%=rCw02%nm^6!mYjHlCR)0z@x0!ms;TFye zi^HYsBn>bRZ(H#%)lw>epW}Ghc}W1SC-=VO!p_y%J1==>0e+yY^OQI3Ne$xq)m`a7 zbt+hC;C5AipB(Z z?-=tU$akzcefanjQE$UZ^#$-j{M!Qz_KrkAtN3G!<8MYlWF1aa?l+1|`3zfaPEo>1 z5)s}1#Mz)x%fj-i3?1N0{7Exc&kU~8w2V<0&_@`lEe(AoMjl%k39An6!=PZuby`k6=WD zX1Nkf(c38{E|dedU7v0{vr~b(Je`pdYGJ4-T5J2|gbIF|y9|X`c;VC)jY4@La?tYM zP-sLXJ#f;wDm{(OQ(tM~BB%UBVE6R_(#Tytpu!<*bMEaSGW~MqY3Ha2Z0Ea`W~DWS zvJyn}nP$=hf`uEYm44-jcUk2=O&JG_J?nfD(1-((HXoYt2gQM}7!vvi<7ea@?=dr} zo&!L}n0-i@8C2%z-+fUh3P%(CzD8pFbC&j{&xVA2Kwa#fP3bHSvX;Id2-Dz(OD*(P zu2{Zzvc~4!Mi&WevuD#+8kU1Y*K#w>u=|0!@!O*=tQRj&;9l%RW(5PsmK}lDgh1V%+w>#OM}1{P;m6NX-Od>QM$P&LpFdF;>rH?5(7J;eF!d5Ykn`e#5&WL{ z|9;~jNtDAmH6aEl-bp6$IF1@PUT>>trsV+%GxM&Qb|NtUx=dow4RNRzGom0$C<3+* zo9`xg;lQ>+g1~cYKDgHWc(Lp+103vs%otw90az`T&4S12Kz&P=#N-`(n4R5w))zw# z-@UM!ueyijA5X~IDIZfn&3h~!=L|T3yiWVKX-XXMs%;QHCn^LP0{Q;M@3KPMSA46T zZ)pK_3q_%;t{}*cq#*owZ5x@x56jUX6M%6PbH=2J)X+tbF@)naE9mYX{z*;u64}?d zpnWjG1esOSylpL-&=T=1{6Osg`}54CimmD)TI^mORZd!lF2zKXQJtP3cRKaFaH}Nn z7Fl=ksqQ>Nj>cF$XJ7(~K74(z>BmsAt9{Qpo-@KJ*D0|h`W+-?JikB0f&#GqJt?)o zo+rZaYqcMi=)k+JL_;zrc@R0j8fCN20xyb-vrwBKqm#+enw4fEkT*H_`^Af-p!J>x z>d7nw!{`=|oujw_e5hdT_v0L}7TdJAZ6^VlKRV}b3Q0k?X4R=i^NZlG?d{r$B?1sj z-zlCz}QaqkWiYU zws)jTfJ@}gwEKz#ymY6e!kJqbavtRb+PMgW0!O9h3yz|IviU!nqIq$wr+HjlB}vcIRFCy3x=p=it8d&~>qp1y5g#0Eu_UOpT@VFe;SM%R1a zuwi}@^g(M7H4MIzVt;IHo@k8D%PnFn_f%A8U6yZ+dmruNNLr3(R&QcxO~ooqrmrp!>KKzulE(sJ=N z#RRI3aNji_Ck0hgzW!4!n+TEB*U$KMr-(}B=;JYLe;t=4AAdd;+kX;AK2vEW29G3W z(Z8oN=tW--ecp?bn9+=9d=@u>{i;x{cvdI(_1 zn0llTw#U{bNAFd~p984cqtDa4eDFK#^2t?(Fk$H*@g!^-( zz5Oyb6m=9De7C=W-femw5&E49cn)|oPGIMjiHSLIPI(&1J!bspfN?FJZui`tlS_i) zfXC4^Lu7zs+|NOLksWffwr9r7@B_z3_ZhyWNCQr9WZ}$l3#CAwtkv_#z-sa1&K((U z7*DK!F5E#F^t~K@n<^*(g2NpmN-&OfXZwhX!o1Y4f)B`@HF3mWehEon0BVmTnE~;i)4P|n`%wSB^9WHX_B<_K7o*N) z1WMGgVoP)D=$~a*Cfjc;knT5LuPoUy+Ice{;-tyIp4!x5U)BU#%o+OT#ToH6#4?;))BZrkK0vkDXVPa=(YpIrvBHWYu$|0M%WlftbA28BSR=;((|8p)ps6g-eKyI=ZA)fMX()`K|dWRmBY70^T)Mky`e+wHzh|)Z| zf1d(`+N4KANNg0W(RG84#qy*SYIAl znbyHB1JHZ8tYe)ugCygoy?&;X!>lJ+{dwv1pqRg13}SnN`VF@%reGYFH>_(-j;05% z`*~+o-(h)0+RN+>xtRCVMbFa00S7xHwyUX@<)gY%t8$tM0b^ zCQ>>2RWt7v0~Fx+j=XfhgW8iccdezEK!Bbh8?zD{xJ}fJqanfi2@g$~0N04MEZ2oy z1h(Swj)u^~KMF4k-nh=8D}-kYd7W4vc|$>cuz3$+I{tD!;~W=Q``Ai9b;tn^@^6vi zUE_e~mF#~xW1Mnyb8ip zeLOoD9;QpA>|=wPG8=UcOT=I-LFG|tH5~{w%!}W;BM4pD&c~xQyigU7ef5(8Ep(<@ zbG1~!-Y@_9MfY42gz}kBQVG=sA&JxMIe%eUV5vkbBZBcC^A68f+ZSZvibu@*jYwgr z5IKKm!bbx5b9ufh{*Muiq+2jmt5O2>iygd1BslogiG4DFj1QXK4im(Ih}mm(5P- z8!hm9=aWUzSO50?HPeUC=QH)4=6u2s z{rpVQKkf)6ezL4wR>}o_)Coz*HyxocY4Zy4e-xPCovnkTaT5uC{zoq;mKN)QD94Fc zkikncn%zQ5duT;<6YX*|F^F(f6w^o6(eqFE0>c6cp-|k^b>r9TsQ<}Kt#Ahc_%jn; z_L-9olzt%GN}2aO11 zDWP)Pz<9A8-*|C}kL=(;OeJu?d=t^Mn~i?rL=MSw6;*3oa4@Ua`QEb%SdzQ(?;mY_5xUwwe5%{i=>Knd@cK=(cZ(=JPF z&ki6e|CTR}ZXToSKFznQ1eOquq!ROYFIiydprF{_5_VvsnSZCKj~32bbT8IY?;wk0 zk83N_xqxY#Pr6LPIxVnP1x^YWx!fo^ zc03Qm7F}lvHQ1mA#jH@Fq&TSX{9;FO1>+jCQe#tZlftTljD)ktjPQ}Vk{#ayJ>0Uf zP?uV#1BPl(9C($_kT+$QOFlkgfgh#B{-FyDV3|_NB>Ma@a@=1VoA8+ls*zpF)>h#L zjmK36S?hej_v2u<`K5J4CAd4LFNGg^r2E7#Thjw^M*UWHVsc>Fd}tVaodYIn`QV7V zNP*7eEMD9zG0Z=Gu|K_K2Tf7`Rdlsc6n1rTz4W+14rBZO`@8p;6|j60wNjecMN0Lj z4t|WDpw2QBB#g30sF0J;iz$UsWL(ly)LV-MOhjkO%X$!jAi~8LkI!M}Au@1S@YgaL zw5oiea)c7@<(xdXC8q#6a{bSLU1tW*!rwcdyUGBQ0*hLg_{pF)dTKh=#||Vuy9#@y z)gw3C*l&8`Gr+>LzovfJ`}wp@{gR&hKB{gMrSR+l5&ZU8iR9v4cG!BQfAnJcr#Bv}&BzmLRT`>yqP0_)d>}7ti`7;rx zJtzYlh`tL&vkO8WR_S#95f|G z7t&TwAd%28XSS6Yyb}@24@7a$qq1}*AfpH2{d&Eo0-L*;WETW3yD`G8jzqzr13bX_ ziAON$2L;F`&REf3KSJ_j0u=BSHc|b2di2*vKDbSUZ@lXY-H| z(ugh)#HTQTcIsE}bGo@exaysfD{BJ?t)EBb6Q!TX?>+)zk#GX|O*3{#)Nl%!eUK>} z;a-pYy-RhqrIiCpUvc)^i8w}$ugPBZe98?{)2nHnG49@*zRyfhkO`KrG$Ch(8vs6}yn3AxYxG>r%2QiYytm|GWOTo5xZDbbM`uq7JE5^(=P6a`mg=^1kn z<)tL`*BkX{M?1L&r6)0<94@ZhsGLKDUWHa^Fpnes^@Vm6ZiLV>L=N4UIYKF{d^%&7 z$$`cu-yXgV5oo)4jaR>)9R4dzEAo>hhAy9f&^=dX1#Yj*|N1Ku!7rvOozFMfF<;yT zeA4}0L{BLFq0y@og!U4BC~q1!JXqQEn*DpyIK?+L=3pDRu>*dBVIO6ik&u{3zo(KGXDNd`C;IJI7* z#O9N(zg(yIMPQ1gqKMKO9sJ6gDLH(L74(^G92m?C!PVw}En4(n(7|f8nmzSXxuTpOibztxZJ|MDhl6|g*@kXV>PzY7Uy*nYfdP5_Zx+LDQZJ`>0* zL6N>SJVN*u@r}@`!h?KfGRsGEXXr{#ztgf6D^#z@-Es<{0dLzr?yy}wMwD+qsph_h z2X~sM@C$m$K$iME4dp#fke2zrO0V?G?_kgGSgN-*er7dNSZ~_r zvh*DtA{h1e*H}UI`j&^7Y|oI1e>?7PC)bg0uRG#3-yESIz6SMQ3pqv{+ixPeS8!ls zcBIsBOc2)J{;0si&j_uFj`=ehML?7Rg&q$RDF|nN0;i3*U{b(s_=bTF9;+x#1mQD) z!g%^?`V17HS~jpV8ta2z8J7H%iTPk}R@D$5#O|Yh&c4xl*n8qgfv3Ac6t)-h%sic^ zSw;reJs;{iY$FK+vuk-3hscmlQkF(HHE^kExvTPo80ZH4BPJ1FMMx8KBErnEbDdJD zId+v8?t6D|a#QUfrkelxIUG@fV5+&3y>R`Reg(pf+oe%++>nxfMtqGu@B0bfd4oa;_#sdU7T`JS92Ml_5oQR za+MW+FjLpC0UPL%Sz=MR02{{d4LJ{e{)b%S`S<<}{yEIc_vO02&o)Xbu_$cD&IuHI zpIvKdB!*4N|1!*cust!~WgV;idGteYZ8H6#2w=a`LCr%jg~&Jtj4IY)oP6v|=H<{K7YXSemLDUr*Q&scfqmg4n7^gYf&!rI&DJ5emN5VOQMDOE2ekv z$I$_v%qlMzk7cwEJN``#2dJ!wul&vVQ6%bWwG)FJABd<5EXu;($6Lgf@eZT7Ax_=& zQ9t%~{Z(Um1l=Aduq3cpYnsL8cK1s+UIZ;8x^uCmKRmmUUVn>`<0O1I+WVL^oL>se zZN9nh&2)w~R?RgT%*tY(58)#6AFRL$+lWb6NrNRJO>u#(4fF?fc4l0$0Bl?D%4Q{} zg#~eJHUDjK0vC-xQJ*YnA%%AKqcb1`*Bz>sQOq~x(xzoDjZy*CRIAa*L18!t%L7L) z6G02g-6xr*#NZ^#>mL6+9;~c+8pIUH4&~DX!dCG~K=^UHlhWKVYVK&te_C$J<3fP3L`F$fqe3UGHeHz`U;Y=e`WszoG`+UxQyha}ogR zL6*!ZqYTh7v9vvwM+DmH+=F{(X9y|Z;l8D^AfU}D_H#QR1->rHi9u&VPE<46=z1^jPEX=%+iMh`Fl2JI{!nnnbM-J zFp+`ahAtbq23qhtOK=!5B!qEKWj8wi9wVHkt?P7l<@n?)ao|C{_ghbZ9@^jyvyG+?qm5z_W=dEN?ORPM&(CB!;HUrd zd-oYJ9ALTR)$kEJ;<~~!t~FFxUrh|*frJcTUfl1=tm6P?=}2MajRBM?LR)4jUjnLs zb1IQ9!-3LUy#c5oK1d^%i@fAQ0U|m!tQp$ZQK@S6J5LYsfg--szb}atU|iN?VCLd5 zQo7?oXmfQDHBAjN2sy$5vxJe1niLdeXAM&iZ>dEu+!Qkzs9Zp-JudO}{`Z zD_OvdKT81}1=eeEUg8CNFy`Sjs1yBujTt`Vakjpgw1Ij*e)_bbjt#`h@#S(fQvzS5 zmnG!=o9MLXBcYgd5%^#}eCtet351Pi_T5aOgGveGu7<`dNV9m65Td+}R!|T-B(O7p zG|wml*HvOTbv;&s7V|EDnf#1*<2)ngJJo1SapD03FgRXi()^MKqs@=!^)inc2z~Vb2<#6`8@?^ zMuKdhJaxLVu80Agdrk0fXr2rtkrHrhi)^5|%LiArlDla)RLktUBJEzGB+tgGd4d6JkinICvy`%bXa=(sPr&>a^qu8p`d!~1g#Cytl&)+Y{eE(Lbc1RNdD-|R zKZ*MmL#BsY4ufULFHudbbHn5svQkj_NvsMdQAd&+9x~*u{_loyYvVL##_3C zkLVLrvVvO)q9Xb?nZOpa(B1b8v~Xr^kAm}n9D0nJ-_vg*0y_pviFp|B&0YCty0w=R z{#9;JGN_}6J+k+xhcd974c|wVE5$KgNLi_9 zcBFtk_xRneZ_`2P+LyAQ|8`^d_pbIBc^p{sXVHF4O#mfW2Pd1irjeJWI)Arosi3zJ zsg*l7Jvjcr{%Av#7JsKrH>gBUO5+ zo%STSih&=D{+_G}{kwva$`d``pYK5aERu3ATqg!bvH~V9ugIWsW(|S-yGCShg|mpk zlMc+#h^bP9{6RDJj9mq!-l9*x@Ljo&-3KPV1zb_WyvfE6a>VmdY=AOo>xbWcJb0bh zGeDSx7%EZtrZ`nLqRx}@ole|r@IOcNA}!G>;=n36bur=(5^nTk@YmKdnyNn?GMP^S zKN)7!eKKGLMZFgR5MDvmZGyW?Zm`0K7G}Mqb_5{iyZX$*8rIK3YXqWIvHjb`wPk|I zKGY+p$l!GwDJXp^?($#X9;#%Be=WHf54x$_)V5${rzaM6M5%!b7)1PNDFL_!~_L=lJX)X$|5J!+Ep>=?o ziM+6gzf1vN-WDsmj^$>`743e~YMdcAU*XxMYLUW(-8kcx(0atmYQt{a{RmNXv^w8H zB?GpujfE@V1fYb2TIVQyktI7;KMzgpXk8>Ei-cz(p&b?gy6Ji z)bAOVJ}TEGEXDS{vJNbx}82fq|J->jfE>u*d#8>oPk;Ip3Q%u!@Z zJAS6Yw;R1w*JoNsLkGT|dulurKZvLjR}a+WQi8^i@gdy_KFG>Ht}Rr?2zupodB$5w zKmY(ee$(0SHs`L(zg6Kd22_Lg~<_SWOqUTx1 zPXL#H>pWu0V3HOtil8&FsbXu{i&E$l#2A{*4(EJq+~~=>~$KW(6*L8gC+sk_m3G4l8xUKa3?E0^E% z;{?)u@MGxm1`*`w^JwZ%I7DhDq^Be+2taRqig_$Di85Z&Vl`hlMADjkIn_TbBb#pZ z?LCWskvF6@tpt@dNU{LM&-*)MF!kwvvN7f}JH2tYJg%7v{9`T9T?{9JFaL$4-)>z- z#1+=QG{uO6G_AQ4enV2&wfQ(EnuQ%6)?Z$>^Uy5N%8w7=D;UX4&wEomw}Fwo1#sZ^8$k1haiw)}%s1jiF;F zpD!UZoBy<8e3t-){a9hP;WRqevmRz0I*Vd9DRd>x-w< z4UqWPgD>U17;F(oCNX=+n8qyJ$JIgzd(D8@YX^Uz7QrKx-N)siY))R8LJtp~{?Wy$ zeuNSKXYp%wvbzmLzh|*hSYH5!1Jdj?rMx)Z;<`$x3meWDmNrq+WrF*!G^{T5FQfb@ zSB2--n^5uTiMz$Jgg&0FJiEz(ImC2I6gqCP#q=FQ+?`Vp?;FLvc9x&99OZw6`i!A&&`Zd=1;a>6!>Mn;F)Uv)_ z?|73NgKNGtk@GBY+H1Dx-9;9-_?-D*h$|1C#UQ?j<^ecUi(X*jqe6o( zO=7%(toT9Zkj|DPp_`4<*cHTa;{)$@Wt!=6!e|8zHL;*Y^fZw5idX{CPjnD^#No&R z9d3_Iz4zY)Cu<6-!>!j)<(t!9p;jB{cfV?3n}Psr;<3$MN)^T!DD2G18bWWr+U%a< zTtoZ6y(T{lAwkZ`*nx#pyl`@DO04!)4cK&Oj67exjsDaf?Ua;S1En*Lx$@r|fm$ zcUEm>Sd$yRpy@xV^?nRo9xndWHz|fq&rGHMB=WV+tB0z;`H*q)a&oL{iU`ryuu({0 zq=)eri<2GVxS{qN-Lnc>^tkp_Xxdf$9prjBxO{ra0yn?+DRb*KqgwwBx&P)yfc2@z zZ|lJ%Kr*^Qmm|gz+Y(uJ`pGJI9Fnu{#ytqef7XZ^yO3Z#Wreqe$bZPF_~j1{3gc{V zsb|Y&9QZ>%a(Q&4A6!;@YkOq(HgMe4w9;Ng>?h9zDY%-@Wey+5(T9cw?H21W5gMYokmPNE0u8!=jckc|OfJDaZR zBfJ1uQPx~!p%k>}YG9|9u;7f>4Lw$xv{+uD-pIX<2QmgmS+o=V+*hl%?+*u1uruQc zPt#)q;2HPM9Nl*`u<&pe$HWyjoIUQp6hk8J6Kz(B@eBy1e9t!GfV6PHqOGLvHsJ@@ z714e6*+juN{}AF4vA@nOW3i9O?f4jOo8%1ir%H*Kp4;7sq{wPd*n^mWp@-sskX`%M`G zq4eD-r{gT1A}51#1rO@;mTr)G?)r#_CJ%N$G-NKS!~lm6trfc*7QmGmrn^1MJ|ODz z2=DPDbEs9t)eCPB+%i6!_GD2Z91)T9TAG0e2F>19XvRC?*yURx_&F!mD+%G!`z(gj zDgDAiUwC2jY8sOwTtSWpwWoaFGU78cSIeqPD}fo;&-$PpVo;FN-SC(jBj%_Hbo9(w z0q#EO)9*K^Ff2=0D!5Y^nzl-k7@yK$8sBPGCD(D(;iw-K%1nnX^md-}IZE(AN_PD` zpvZ%FCru0mKdS&eZ+ZA{iZj4}pVvGD{tDp*+l^=MUJ;zBq3!8Kb`E^^Z5;L1Ic9A9 zgJB^qlnVC?#lDWV_ykJTcx?=1iN3zWckKp+d7y8}ykM$Kh6kMZ!AA`b6Eda}XE|R_=&V%^Jdarha1lEjT0iEenBd;e zikV|6WE{QCB5XvnhN53C(=xFTzBVeHjdJftitb^boK(7yvPk%gYaz?ve%jPXU(h@< zIq>avR?1s&*zt7v!m(9gw^DmJy0;5OE4AAF=gS43Z5B1ggw-JfGj;X{khy&zK`eic zC1o^Y72OZB{H?D-2b}{~)~=}0!34J_o&zyFSm~Pmsg?l&JQ{O*T(**gH?v)f?4{{& z@U-^<3&PI~+dY3%I&%aR=DEx$dut=Dq5IV}Wh(w1A;BcIe*=xxoGz`b zS^(np4024pbHF)P?!ny*NqEXOi)rT$I{duII-9zm0c)Ne-E&%$4CNnZg=;90;h~&( zkJK50TN-40ws5!tIQiY@6X{(#7VRlQ>&${f+@$y&NtEf!Krtwv>2yU+mJ{-26AG*kOEtJL)+${fD?{v`t zM0(4U%$v>)xt2ds&X4~^k8Vod4-VTxQ_88ILZv&vi2wEdd@8%3>~R@M2&dF1n25ypJH}@A``rHTcLC4$Twu6Ff^$qG=%n@>>E$T+-aQ^7&|gFVRDIEcyGcWW^F_N&6gqte+F_`xjBAO!R!t7?3Xp zW-(w^7r$Z3Cmupy5B@E7cneghICjUL=7lzb86u&g!nkkzi7x}|CaS#jTDjx|6Rc@q z_ZV>yA$F;Da;Oq|-&l-kmfQ_0Y}^~;w9k|gSNQvkjc3x}4y%EGdy95J#yIVcA&= z;oGa?Fs;#gMTN)_xgk}bN$XYg;pvL|J^dA+C~;Udjo1Y!4CUNIGqjF=t7+en`hN~b zF7L_ZA*B7#R@Q^96@{43TLeXQfK;Pr@sEFxfQo2lOYH+gsEM<$wR>$8rSH^>{A$Mt zNf31v&;II|dheBg?^)?5l8<}?% z4dTH|RV#1hzDH&!SlyVTQl8obXF{ zxipyM#0#mmMc3sSG4I6Nl3UU|FjIN?Ny{}hSoX1o{*pS8tAFkr^64-Wz81vZt4Qc} z{&n7ZRq@O)xQAmd+jJYH8EH$s)1rZ!wr?gM+*?JL3hTq2Xx7obE5DLinRqb09mBY( zUKa57jFF6D<%T4o)b2DfT8uw4p4GjR4}RL-FXiQ(0sE6I3ucRi@ZKY`1#J8zNDZn+ zOpp#fNRYoZ^=k#G$ytf-ZCpfihc?eda!iA&o;!Q82_KzuC-&?I+jV4I#YhVM!HF+L zR-dRWpu!2|6Jz^E=-{3B!zMvD7Loq*HPu7v{YYOTf}H8h534$vxStrTA~lka_?Ia< zY%KYvgP}(VTBLc>Mee49&xHbOa+_jMl!H&^1cwOR!$L2!`k@f?xh;((Cd`1~^Axf7 zcZl6^98W1F5q90nvur82nCWfQsoA>G)_5s=QranwCZ6 z=0y1e^tu*+huAKTrA~Hu>)%xA=Q=8EzQX$Hn-wec99Q60FMo_~#hAuw?N~S?Yalo?i?gcf>hUDTUZ<%7OlTDl6X z^XOloANPC*BR*J~%A_OAfDfhpQvPSRg=!LvEhD|T;m?jppIH-v(?6&1Qtfsva4A>u zF5st!KQeRpqsqsCqwbFSb9pSdgYa}&eA!^7do--N$%1$EooxGNLl6BVL!&Kgh zKSMZa9cY;@OkGjwL`pW=7VsStwsbq7QpU>;jW~~fR7@QK65;-3%F4`GcsbO?dU6h2 zs;y_Y7_CR=V56ZHabNW+zxDMj!M(cM=*bp&odZ8oiEn*fM}lsPL97n3%+U35=D_PN zGIl=hHJ2X6gKuizD@e*G`n62g_f7ud#F144tbr0jklYl~;Yn~03_er<2zH$7-m6| z!Psv{{~qwSa;NO0i*ukjNm|=ewHKK4GGF~+DG0~QeUcuRQlLbZjM+Nj+t6zSM;YJe z!c7N!r9OXI2L@qwS~{KU;CSo4Kh;Xyn6dXYvr&&AHovW)s@nX2K7(TF{Z9z_R1S*n z+N8mJ@7spiiy2{YIr}#j`*%p>NaCTJABK>x+g^8W=P@*_?i5E1 zZnI))+2FSt3Vn;39;QMx|bJTt+WR_i{if?ma z@AGSXPv%(hg=g)|GS2JhyvFBr%@2RkgL2K|B_W*nfI@hdkQ%}9Nl-a=_}ortr>`(- z;?jbyFsZ6w_1}og6R_|y4FmmO|LMpU&LUU)eJ|v5nc-aew}wIWotP$_bR?;jiq%Mb z?&AA7VchrghzM$;)pumeQ{iOzq4n}Z3bhSLGfBkqQU=jVuGKRoDLSm&;(k{}fP|$o z-;wv`kZ}oB)I6w}7MDhcKI)ez*zP@)CfQ3ZKqFi?DOrh)*kiD`tfRGx=DBlr-ylyr09%J^25eA!!s0_ZIphl0z)lM{LXJ)#$g{b zj4%`wXq0aJ$|C zlZP*7z$x04V=W{BI42`*daRBG7hyg}=6qfplycAUavcY*{%l-P|8oeHuMfU;CU$ZX zWnWdW)o&n0mNeS!4OaN3X1R_965Q#ps`P0gwIW zI_+P%aH|Dle-feN+BBISZR2?ao@Kqck~Bw)brmL?jCYeU>E0jlun&yTT3%nT=Fcqf z-gsfTa-I_|&U;i$^^XDC;E&RcBr?v(RXTX-_B;p>x!EzXy#?~RT09R^nBmE27$op* z4n2?Ch~CFTfnIZ!$1lBK1wCY!YBz!@F^7 zftCzK+0zbPBQ2xzg7$+n)9hG2a!fI8sss&q+AZ$U5roP?Ke?gI5;&Ys5Q+lH&?u(4 z-L`8R-B~@~Qjy02$yJB4blF&7JnzQ$qeLFPNoj?WnoHbYD^4w({ldQ#V;Bttf*Kb5B<8YNf$q27=X2hN;WP%juY!|)%Sg@UZ=tDDNpM{5y zEvX7|knmO>?x+-6yb_5k@_VoD@+-wnEdYxjLRkY7a?A9Cq zA<#jrO`KIB_}lEXxGHKGX+3RIlTl*A3PRye-a4(LPQAsoK%OB)RklCqR5lKNTyf3S zI?9FbPn0npFQ>r?D$2k91<#;>4f(}#EkQ_I>qc?-$pJ?NedvDdpFt`%B)3T=J~%9u z{Mq9D8W@UuP?;PygZOXLdVb!+0)>)8zdb)S1Wceitqhp~W=?eMB2}jXP9DDSA_WP& z*XE;%Kl+WX$o*J1oEiiH_EpRy#)2@c@Sw&sHFjv;`^>sfV*|asFEZX6`~$2y^M4EH zW`a52xgK;hG2=E$Vf%IrBNiHe=$&oC0L|WijsIRtfkhHy{d9ysv+2cu=A0%4zg1IS zAkWW(Fs=BB_)Tsor1VqLB!3=xaJ1e&PUvJ;TQalk)%Y)7Jkc;KH7QMc$JPK-?)jyh!$+)Il~okMj@ zusq>@$k%mZueM(}eUCOD*3W$A`&xUt_NUk6apQ z^N9bTIF?osLd?koNH#N2;u)!62f@U8dbea^p(YeKe)5x-0 zTvrEyn`moNb#WKSa`>=WKR^fNCtD>t;>ys%ky)i~f8sq~X5&y~GYg7Pzzf5MZ7>y6 z^O^$;p#+7Nf(=b>Ov!WLtzDzTspk(_t;x|sz9@!Y=7dl5U8KnT!(uuJQJ%aP!pQ=U zdmeomsI-CTHTPT;x=;t4tpn(y$Ei5qXv9nSDhaDyN%ZDv=E8k-2RSlCno!4T>?ucr zzjf|~layjH1y|v7UKaycAdj`5gxU>@S7G6(iV*^gGIzN)!BK3jU7Mm`D8zGn+{%}_UVaOlHv7) zqv!I*IABs%$EBgW*jU#Ly2j5-KQGja z274#gSctrm?+}ZhjQ9w6irbuoN!`HqU+S61>r3Fo8(G%m*K}BWaDX?q|2L{_G0A>) zXB-rzSU=X&B)F7`CkND?Y#@?4)l@TX0=;`Wd?vg^2o@_u_!$i@q2&`%`^?|c!1fFu zqX!q5a64~>&XE5$xD)O{)3s{`3_AOIxiE6T-lPFdV}~|$nBmWu(yuk}V}fQq&ukX> z4*8Hz*pV@(skD%L!YYw7EY|U;SOXd%Qe~q0%V1Z8{jUrn@6~YDI$%D5;3|`Cga@^F zFut^J?xTG(vVT}|gCa_Y16j|?t%WndC|$Akb7AcGW8IweW$kg+g=dnx~GAC0hm7zouWhPP?D`Ta| zRFWoyRDN&2|IfM3b+?O|$3N@Z&$FJj*Sgo*`+n{BeXlK5|EQkfacU|bsz4Dt zd(TrIA`1K>2T#k3i1Uk_cJ=V`upysx^{}&F{anN5jHf+5_jI&zv&XThw49VU{~jqR zF>(H2{{PnBhA%o=VsnaQB9<+yPh>Bd`1+Q%VOf$)s8+pwwo9B$L?sR1q25I%oCKd- z_r$SOOSr1K6qz{o%B1Iw9GTcb84158KBM0v;;gTKaP;_i>JGtGKrg5{wVjg|(PprZUyEI_dU z#R3!yP%J>P0L23T;uiQ-e9qVdeB>lQ-m+DiOuRNV{&7i!OceZ;eD{oxOvv7;-?YF@ zCfXx8vJZ2TiMrmAGd}EOf=lkC=oXZhsU_bZ;UE*jTMr~Bagm8h$txGQc*(@WcEwxI zg~){RruJ9L;I&K#N8YggWP;)Pr5`M+WTIH>WyV<@GBMQ2#Fc75CTO0o+vg4bx^w9R z>)m5y;&JWA-Q1SoxiYOs-KWUJy3f%k)LqELn?V-_P7gA1o0;`=q7Rv1<5~MT%$H0Y zaaq`M){9I`-&bv^B9V!o4OEgh@VmIhkMSI6Z}4N2laDrq-~PpyE2aAs3s5XTu>i#a z6bt-ISis~KjberZ_(Lvjq7^#T4Q;KXCIVzaMfFL-T5wfxvA+FzHtKha)#5AiK2BiJh~`r_|$&frh`7^Y4o#Y1DVK;5&(f-&3)82 z9vvqW1{KWb)p4BCA~M2gMJ7lizpX;-$OQe9yEnMNQ-9UZ+v|X{Jl1{x@Ft8*@NMMi zWIsv31s4xi~!r~Sn!-D`$^YxWFmA#^n4@u%#c05 zR@0VDaK{+Plt5SemzYFKCn*-7Sb$;yiUlYZpjhA^Wr5QS8;UHzH;>EfWyW@ri43o< zq$=o7g*567hMUQR$(WRa4l8t^oX1S9>!D9^q@3YgOD2RYba&sPCKIO9x1!gtAro)E zn`jiTBNOfurBo3c!7(r7J%hnhQTMOdY6?PcDvO;J7bX+cn|Jm)Kp*RL@Mn@11^0YE zrac0#PHw^{5k>IB{-a+ZQ)7Q8j#${k}K!vjApk z_5kQ$Vhv^@XHh>~HF!P-`r64-t^3Jj;>Tw#@tf&nLT@R7ChQV8u*cnhH$ETg7|pwY z`pb_xrp=+FOk=p45y7A@0Z1aQxbC!~MiW>3+D%?#aApBYyw9~PIJFl&D;8PS-C?g;1b&}aja9_jxgvl`UHO8#KtG5ux49+cev<82*MbT}O z2H#W)7dJlxPjQYeQg?uRy3@~CE}bD0R#$a&?%0zFv6oKE7omHt_azxe8G(;d^+@Ul z7@yO*v3TTv^_Z;r9b^JdoXgePjFPvpN8<=e@t3jpit&Awjq!{R>f3I1*lUSAvMGrY zt5tn1a_&>up_Aaa<=>Bv;k=Q?->KXD5y!l?!aW=fUfUjYIh!@5|Y>@hu_bp9P1ZAyZ?wqLFoj=0u&2SEI_dU#R3!y{EsZ~ z%}Bn|4RNrc8c{g`6~qDC4zAz77kTM{8X_FfvufVtbd5lN@;dESTOt6y%AtFihvOB= zQRV`~`K%jlix_s0i4TTB38px1@mb<5z_FfUCQS!^e|Syyv-2`!!gcD;E+Kiu4KJJX zoCYT~b#f;W1epk2ew}tmBF(kpuruuZyXJAxMGbu38ca_G4jdQUPz<<*MzUxkmjaiV1{<2vgCGbr7 z>yRsY;D?h|Pj=ZWLBG)`^1ZZ&Ot^?$SB#Q?UbE{&#W(0so@#Ty+rS6>pZb02!Ar3v zdwE5nM{(tenwFx})qC@7GfLx}jBTypsJpeJ7q3Hi3ijQx!4I6`>9t8V06a7zt8d$a za%-L+*H&=Vi2YteR~-94Oj7ScKYmY+HXqR>6Y2KFhkt@Y1bL+!&B0*sx zh?hWo(M%)D=A9FncoJgDbsSt|sI1EsjDB={KCNMaaftFB^?rhWmj21$a|VZgk-A%)SGlz*x zd_2hWUW%Sfj47qE+0YoB@;v_7+5RG{oNxgjW0^+4NWTn0&VZ3Ae z18$?dGT?0cB@X)>l&T`Xf!{cdcQ<(B_qszFeI(fRzq#xvKciTHVgZT;C>Eet;QzD* zJfF@mTfpxs{;2-i4=&Lg`BCK!e@y=;@$4_e!(uXP9twdEc1B+=OjN-44VJ!MD9`w> zn>YyF$x?qj_yc&tcKMR@NyOFE!qtrhp#R(|(1_9nuMKptC%%HdRI{}BNfGUpy9>pH z;d3qeVF^yu(>MyTM!3CG@pWcLa3qR1M<>B`m zY&YbH;C%IqL|+{E;SF_fbdER+!S*I zceLN5DS_^l;P~E!3A}YiLeJeQ9`C6zu1FtFtf`=HBy^TcY@Ym)G3*XL zqO*@^vLO?_8Si2Tj({s&Q@3%03+uPg@}JYhdocV%9z2456F3Y<_oLtDl43mx;L-R3 z{ZMxB*vi&h!xK1;?708A4!kSLUt4$)dRfW1QPbRB#7(t^%-@S*zK*Dm^KQZZ&hhN8 z*^Feu$M2+|)e4D7YVmKIS|AbW$*o4ue~}2zKiRocw9p-SJ8tjVNG1-Q9b{e*Kt7zs zdZ~Bd=vG@O8^v0ZiEJS2zPF8u`%tZ z3Eq@b)BX?fn?(THotgHaE8-yUlkn>#38eO4HLfL zkBaAGy3mDwuD`Z_B?i2e_q?Aw1@S=9dC4v5(Br5*-ao=|(82VjS5YVf9oG$bqkcus z*3b52;^`A2ToL0OXS5QY1W&d++RT~_9gO}x^_hL(FyV@hi8m-4Yd-4=U_Oiw@#+O) zoNug;ORwga`L^*eCc=KsE%`=gun)kWC%`ue^H5dVR=5V7bkn|UoetVpTq@>t1?R0~ z+-JY5Kqi=}er^e+OglGc>}khpRRux?o)#skn4A zmJIz)iOzKs?4^1C6jO5$xc!(-=v&yWx%&)Pdj#qw{>f2>{k{obHdIO=6XfAD-=8I8 z|ET%tM4Ke!-?2+-MV%)TYmSM2AH(l6Rk$1CFc1H>7cynw6bn!+K(PSD0{_%zr_!)54 zjMv|fKH#Cbq)m2`;41!ley@W#mb>OBxeeb7SXd`HqWyOT-WO$8x#5&`#Q_|XH`OmN zg3I=`o?FgAy`fJQ6P#$b^2{#w-}u~MeUn`|>OI!cH5P+z7FBU7XaIhmccslM44maE zWVX#2I?zI^(7Yx1s$bM5?3oJqQXtJW0rekBG3`nb|=2VaB!7JuBx36@}mSal<1*vRj!<%c?jMrC{s+N1}F60*EObzgP!-mrp_5$ zz`4u(Kq*T9M9t@K@HyXY5uXy&Q!2V(;O36;2CjV01qYdy#cwmic(`{7*aX1d@d>A7 zF2desUi!=i;Hf)DU-)EWJa?Z9a?pWOwe6-v*1-PlWg=Mu;Fed^56*4~h0ga#JwpQL zQNBFz{RPfjr}$j_N(#8`ss7Ila0_=*>IF{l<5hyX(hT$DYHBGIi1YOF$+AR2$0B=q z@Anfx{PFtl^fY!dLA@d8feaJ$wUpVgdnjd&YL_iHp)wSa*mXFdx!g~#n};W7C0Thi&JIpCb_mu)_4 z!r$BejV{-Q|6LgWZ7T>r{?Yj3Hv{M&m&dy6n!#Ng4~U&M0*{@c2|UOE&QSMjKe-qF zGp6JH*Fs0+lZU3AW`~ZV*_ggL6S_+0S8dOJ{Ql7y?(7VF-Zc<^#scS&Kf8Fl0qxr# zq$%#e_fxi7lWE|k{Tp(K4n6RNa@Sm+7WM^-2IU1qZ~9XBIY0>dnOK+V&1-7N-`ce; zIt1mQu!>$4IO%j##<|YHmFF=?1x~KmU z%20cWS7Pw<8;=?~w0S`HI@s}k4D}`Wb{clWE}o~pbtHgiB950+QJ+H`Qrp@k3HsIT zqrb&2MnKOy^pNK}bg{0#eBI2bFW|z|ssufY%X?qA66}0I&4#xc+(i~vkN$#rnvUq| zJPo^W(%Eqd9VQc_+o_Yc;W#)@zn8##s)p%q-hg>oJ7`?~C>ZmyJE_|x9r|42;-%a> zn8)`lEn~G9hrDotWDE2lQ$OMW$^$d~2{P4)LyDQ1d4X>ZTsbaXk%ahgWLR{VCwTRf zPPr1+M?~0?O#?VpfcIGJv?$_$JJ}we<;MPks_&MhjTqm=-e3MKun*PQ&Uq%xJ9*3R zMI67D5KMWv8G4)V>83y1@qPDALq_mi++oQXDa_}oK-azLuy>Af7?lnQT$QAFvMvOA z-QL3KiUic>Ki-gX1>@EZ`I`amvi*G6->44zCaSL;<9h~sm+0;{eGVP4Jh4}_8*$RT z&vRZj;rXFOj;jdc`L^wXhU0mxr|>P))=m^2`?tOEQ3g)20L20n3;ZuzKxUvkmL43z z`nUaC1>$BNlHSv+dF|F~$)^k9w{u2^B=$ppy3(=6(-i(bBY(a{34Xgvl-_m55qUOu zrd#Hq8~9ouY!dT^zVI+#Spd3@9P5bZRafjQ%(&jN=M;FOD|1l=I@Ni@)79GGg!6x+ z*AAiG#Lmg+Jm_S{G{gR6p#Df`yxSS*K(G8PZw-J`e1@BL2*c0D2{P#vq274a*QNX5 zu$9RhGrQr3gD)Q;odt(6({oa<=4UOY2+F#n-|?Qluf3u7@XmRcmx7zdHx+d2?MKP} z{hOC8#>49#rv<R^BYj*Oj?cM&1`je*ZFMMIw>!F>M(^h!Ted3Cm7P$2Ep|pqU;H$Py+w%=Z z;L(7h9>M^6-`b1gQkdrt&uk?bV3!5!QQbt8v{!5z$MwK9-*S99Vb5<_)Nhtx@4cj) zQ?W5*!e(6{M@c?-I5OK}+aqwv`G$+3gUF*d{*`ig0`bGB+aEW50zbA}^H+Vud1pjQ z2HzpCE+r*vZ5Q4@b~|}F@*#9R>hjFjmtnViJ`IB4%d^&D=cO@@JGLk3ve3^5&+q>I z0K13sKGi)U0sX2lfZt^Y;>w(z^A+1L|EDabgrSoS&IgQ9ZACoz^SZn7yx{oj;<3lU zX}UA&v4l9@C&DiGYy$Iqv}egC32{?}Wk>DR_j4#KEU_NMy7g%-{7ZoUgQsI-HNms= z)bclXL_>eP|EAmhBI3(D5mi+;p{oYgm`GJ34{wC-N(;EN@G0wy2jDhdHi1QrS9qTI zF!hA%4fMzZMT@`j`6cf?vlS1>gx%n1pJ@v6{xo0gJ_kMbfBEvIG*7Vr#R3!yP%Q8d zwLpXM=fN~X=nB2IKJt4Jx2oK5um=9^`K6~leBh0OR+ek4dE^0##&6bHAV1w9#_kO` z$7G{I@tQNpgXYVA><7Q^tY*Jh41ME8(V1Z+FYxP!$d`9kXd#ZKQp>stJWzG;oNfsGpV@%b#y40Wavh9XJuV?L#N@p`JqS|zh5J`FK8NEVt%de zlp}b@dRDXB&>sG_xG1UTIP?^4s;u|mFl*``iR+cgMD4_&#wLuH?W-1djWpVQ^6K0C zZuFy5qW&hztIoP>=cEw-N=-LuhMf}AhBC|)!3B5zJbefLx}34`_NY2I^Gi2*RbLBa zSSXUiIGH2{ZtH<-Qdf2*GMSKxqF&Nbk&hL75AP2jMn^3IBp-*L?4 ztg>qk>toln)TR6nI+`6CjK@jx1bq=v4*lB0$!;_~@V4g2bY~2X%r8U>Mu@~dg`(!Zej(M5!2$Xq@ zvd-m9;~eae;wvl{iFGIv*3j&NdJQx@k+;C3uc|WhUP7l^H#HYkhxxi`r+4y_BjUmu ztW1koPwNU_b=zWnm9Cj0vtYf2re*(%MnBH7+s##lkcp6sCTe%Wz}xM|@BME#~wpeYJ`2_nh6j+@KUt(Ph&AFUF zX|~Dth#qt}x*-vN&Z~HzZ?nJN2CR>N=xv44Es6yw7NA(*-`)Z>WsIz;@XN~gR|W&Y z3B&PH{j}hSl)VZLdEkt}x{plrtNzqv_p>VSLBUx2k}mxF;P}m;NANdZ^n(}n!LONZ z@z{11dc?Ml^WO~7-pYh+#H<2?KvJUK2T@fyx|sb9SU{zX2&`CUpb zc%dZxB^ydQqhK3<=p&Lj=Re%eM85cZwt9F9xL{@Sm3}n*d*62Vct7Y6#*a>}#?4;r z`sMHm4v0hFTI9Fc zA%}RJPYZAUA?P5Vw@j}Cf8O12rh66~!?DdwbpYHEu`m5us222@u3t)jF#c{8)3q1z zxh+rY@*(h@T}GMP1K2CK>V>==`c+(6e_Mp@6hjcTFa)0!^s$vhS848{rGd{;DFdWV?&Yp;N6+8DT0{C$!KmDMKi7g#wg#yEoRq~pubn1+2PdA&j#n0!M|`w)HtQ(rxBMDP=Rv)wB_-d0orsUl zH7Few0S|b(T)T(yb6>l#?&f~zT;f}OR54yEcFw6A;Jjm6*SBe*|JQ4-{yd0zi;bt! zICl&C7k1pUW2{BKUPbtfa~s}UvE&}wH2@t>!>l;m$0*&hCTz30V~mo1S`y>Z`MmM!-E`P>-)Wrg<*?7Wu64i30o7#P0F z87VE%`EB5`M}3mpo55=jxbqCPd9nX3YM57gBl4n5=!)GpBR~7QLvy(V^oGtrs}8hZ zdZ0FD*BLzTODjGzhrdzW;U{GQ|MY5SNp%SPmGC3#gO%`KeJlH(Pvt{zIp)V&13&)r zQ9?jY2{>uXr__6;*r!-P=RX1e6r*y#N8~#Exz@$2#_8~<4_az@;fEK$vtK#}j;Uql z6UzrLuHU$`aJL~iXvBtT1-jIh;CPK8^lNN!ioSjacxv|S3mbm$&r}3oAj&l&`<$1y z!*6N{(2eXw-kQbisWNcO)$z^uj4m|p)S08^!x8wH`&e!6Mz;YGWZSIl$^4j>-csVOZb z3Egg?i%3SlZ+K*jv2O(j`Z`5uaDz9KQrMrNd@EzBP{#wiP+ciIz72eNHchA!rJ$wU z=0KDNGJ)m1C@riz?p{T`^B0SA=(k|pAN}?H@VTpz`|BYwaBRqz4h=<|=k)hN5%9A} zYedv6xb~o&d~GP!+mN!NIeP@&vlhqJ=bHd~O8%7%$bwyd=3gEufE@p1ayI$jx@zYnml(dc@e723V4^xKTR5!VGr>)}I>F#ZfI|7b}WuMfOIzX~+J430o=Ebs`sK8gJg?8z2dpRix|BFD&v zk9cm8E%)Gki@2=%0XNb!@cy-n(R5hP7k;ytukJ%7vo9ox!hUD6$JN$@Yws~Eq>tgc z9j7{XFW&-j@0Ia=&rXBGOy@UEqMjD%P+SLiF;2!$kNpas2b!7~EU)6dBkKAuR^yoe z*c%h2V-yQeEI_fqzqkdo1L9uY1;>oieSOCdKhAda#pLSy0kms^IfS&KS3RtMV5$mU z*-mheK#y5lka;o-ybxP(_d=Z|;v|v2D&{DaRIdf)!jFE+l-G-dU#H$WYOJ;gy2AC( zGy#I(AAPqz)lJxM_;qaP%vx~SyNqW$ev^nxp$ocMe@H}Hwb+NdjPRGDenn%#@Xzz= z-VSIdBdG4cCHM{QKb^<+J0q`|$}H2#8*x3=s(X@Qh?}u6+%JfQUUQQ(E*a1L-D!!} zCgDFysO>5{;3pmL8t?VFi~8OJ+mFLfb<1!))`Wlk6&|z@3xEFh7pvbWbb!w+$|<*l z(JwZKXjXTOfBR|ek9NohcPfZ60?+)|m^!%@<1c0XnY;S`edaIR`rs=H4zmq=@DiMn zMt7lS6yuwDDr;2A2K!uXJFm|H9;nc(`wWh;mwzvDNeFSR=bDaG;I@GM+uz!voxQD! zhgR)7UG7*CVhH_(Eyf6hyc`$(qbQ4Vm~DXDerx;m@->fSHfqW?ua_n7?dHKHfs@M_m-1WKY^5z5Z!zyfSp*X*J zz}g4pJE14;9}KA54gDsbQEpNSem?VN@fRGMzOt%m0Ec}%8BG*&V*bCzZ2!)H`W;0w zvUJetd|Za^(n1G&5vFtjCC%l;Wm8R?0sSQqC6D`+wQKkc`7u{~VYYVq9B|QOm8nc*)JcT_I=(owBJbgoK+Xa-_hwlBZLHlZfuE7Vo!AFnx#+UXW z5AlNfo4P*m+KX%MQUl=7#w&+(-(bBDuWOEck9n9mv{&T=)^CLA*U@S4-?VmB^*6+Y zGmP_ZE?|7A@7W8fU5VJOW$N)vu7uWYPHIOkSK{oZhxK-Ru7nxA+MY^&S3>oP^wKFF zS3)N}YWpCwD{MZ=O&tjGU>rWE#Mw7Fv@e7IYPhu}MpCJ)FU8ABIb9n#d=BUe|@Y@AX zENGbc;eQUcJV}>_?j`H;aWzlfn{DLkVfa<1dj(aQI3G=qy2%9iVY|>I^NBO?pI@o< z*l^!h^Itby2tVrXn)6Zr8hFs^+m35Dp=)_b4S3|jf1NaCU42gi$JBXo=X1zI5C62r z%Lnm5i7bgXWbjh$K+vQU;z&;O6J2)jBN57Lt#F<;;?*{ZBV^*wJy+#^4cOtc#a*5K z;1I9NJQCu_56jx|`!)J~kUMY70vG(aKd1v-Pa`OLL}Ymsmy%fq-Oo$8$yVO zEqr1nfn&b$O*DSrx5`I!hM(b|BoDF`tiFd-Otd@Z4S1=PKjLcNAHmpWz*W$GI(jC?IaVUrxB@AoMkBtJ7MmZjk+wL~F?WN3{57pqMbvkGN zK7x*0NV+TZ80YJrG&u_H`g45EfrLirK79ES6?M@0`l5|nYllRQiBN`(CVRrHbF zl~{-{bbYYRl}LP%A=W71N}LpU?lBGSQsK8TRNm}La0=ZlEkXTuo;AZ}-=RYumXIp$ z1!q3|G_6z)9aJ;)cu6AG-vDWX4$;CEuNp$wm)F=rtsB&a%-l1MX>R+LRVpQ}*0_JVX@1XgfL`MJjQxNj{P(6pnmga&=Y=@f zA1=!w&*sFJm|FP7?VE$kj>A7!RSBipeI*gnm7*-IA4tSU{~ueQPmu_!Jn95Se15%x zb2JuyTdJe9`v5)s6Q@bG8T`MAE-^wUj=Z6IFz?7Nr*Zg~CIgEyVU1%$$jqNyk{}5SM$vOXh-o) z*qg)!=;oPY3Mg#th zX5pCLG|sE-(-62AI%Guw9pjSAK_}pIcf<(BLFb2%Ek%(hQ z*Vg7fArYNxo5aPRk%%(=kbOIzgU{w!fAyigNs$L9^}*Tkg{-&usK7^I*HljIW{hQ;A33-(uA6b2q@HhM{_*_n|Mc zYdqWp&id*}o{Xr%zC};PMwtq5l;+E8tNLedSUz=JF*xPgK(%ZpP<9_6F_Jm%-&R<(+{kSf8E7o=I`Y zOU&D2m~b8(ee~vhCd$+_*0ePk*Syruuk{zfKee+=qv#Jmjqc>zhtMBg6K_9k$36zS zhS1J8(3NAEL`*(H7poR-q?tuLv~x^8={KIMoa5_{)3`#q^k9>G2i%1N&d5 z_M@7??{9banD&5M`KByCmw_9bl2z7SfbPk?U6#)gyg4dVItIJfoNOXK&` zkAUt^C(!W|{>?C&nVTMd&{*YnLcubLD5d>bSPGr0$eZrE;wKUzTtZ!Y0Q$w2>VAHu%rqo6FkXgH!hI`>N{* z|5`-7KBEhMH}C-8GZKz-_nK@>!F`W^7SUI@Vz#^8w6hTnmykhivC|$H_R>$!9{nn2JOb1NyNrwPmgU4B%+xs(w)7DM7;0v`*6Aid?n9ps`;2i zn99%PgreT0Nx*a8MiOB*XC&EE3l3{yUGM#nM3ncZ*EQcK5iPCCLJk!q!X_#$KcEir zLw;|*gbwJK^2aUyfZJ&6A3AZOA13#1i!9PX$6FTUYhlJZ%h;_=!+S^~t_CDJO{E=ZMGB|A|99F`l~R1J2W&pBt+P z9@M_X>o`(~eE?2lKY8=P@9#az|A5yTN@;AU&<{R~*HL!oFz>b7TVrtEcc&B^BS_E( ze~y04bi#8+bmd7}7sNjq1BYLrAAFO1xsS2#o3?mp24UPIKKq0}Uc~kBDRuEu}BW(1--&2^fc-S%-1|{$oWogX^Sti817kBJ99oDYHuo z7}(^hx8C1dp$DBt&QXOc!{S<@E_k| zeqROOXeRySaN>lXqicNH8M;J9&>d>MA0(nzpDHI8Ty=$B%<9M@_-dD&ts!_SuDEJz z84LVHJTqSz8+3s$F;`|-aX+p7kWIzDnm3b7j@*jbKc+` z=`T`6A?EN8gDX*+!6EO=JT@OV18$TG-QNp88*1^C#smK6i{SW#vK!)+7R`}I@O|_< zXa1dRmLC2ZeUz{Nd{deWawmiR>`lR$61G+5Vk>m{mp+8Z-F!NQ*DzYw4iTQ)91e4 zi+-`Gtyl=bUuG~op5FvJTpsP$f-XsWl-8CXalynX)f1Y1B*Jm8a)Up(%b@3=okR(V zxU9J_(Q}t5`=1%0f{z`gJ`i5TL4yZcHJ ziI5eIWqg}YA~;r>-tIzKoH}HC2A_x3@zn9$BN6o{1uegV+bSAP8I1Oj2&MWIYAWcW zCf63+J|q4-{a2cL8SAbwS0K~@>!OXhoht>Lzt>Y7@8}>A5&h4}ub|V>Z8_UrhIL3C z=3>N&btpN!f7d>&x4K(#TlKc%J^qTvIX+9m@9R8?yS^VfjbrD=Wo76zl3WTeF;8Xv z{Q)Sm}8KW5mLn}Xx(zwb&VL+?CY|9f*ZxJJd(M?8Q`WZg_D z=fHe4bav=iStC!K%E!qT*BNb4i=nIm*2g)wi3VJU-2t*isQsul*)RI}$Cmf^aJ_u$OI*!U3s?Ru z!JdP7q<+UcGRF0sxp=%X2K~DH`u*yD$jmvm*E_?&=^Jm*JUEMe8Kduy(M94pCf6qK zJ$N(ucu{%+O7&1jc{bSLZoc#SZ{S8Fch#kn>F8HTO@-a+7{rk+H9Lf2ZUHU~r3%};v2;(&a# zTw6mgV_f%3F*;=2m#k>$XSF2op4<_}+@2lK@pjg)cSji$a9v9r{PvH#AyYa;u>i#a z|7R>v5f)Axjr$F!AQO|ZH2ii@kF^Q>doBN7sn^=LZ+pGnE@z16^OBo&%;1LR&waDQ zIF9LVeAABa)4U@NJ^`P7-a>ac7=Cyn)nn>56aN34NA*xT;!fg+Tjk{t|7+-++J7B7 z!*(XGmlTaqCVuEL zu>sVDs26^7nq&mtI)1p@bi+EteJT`YUm+iexM(J#IZYy-=NUVkL)=j*OYQz$_*K@} zk<8Wqqjw@U_#_u}n!2aI29ANZWPi3V_~Utb&4UKUCSBxz@BOTM2jd!fELMr;*Q_=f}f>CPM4jRW{{Ej~qznFoilyq{ zcbH40kD-iCHg#x*A5355xOf=fTP{!?48d`kRp_)3%B#{r+!64zPj1-HY_Nqca@Blu z2{=j8KkvpSoHw}3`!H@ZFv!_}>=RJfY3tqP$E}LV+E0 zINnocR^X?1nNu+g@cY`m)FrF$6O$YsJ%0fHedW{7*(o3J*2$i%W;evO&WzSyf?smX zoomQ4hhBKWm7@msa1IQ9*L4v7Q^3$}_5EKAS`E(5+Yt9)ivBAgG7XTSMIr*fHc7M)o+gDfV=`D z;WQGV8J9RnlSv}-uWhmG%|d&IDqDrJNd$XKWLL#y646!@FaPxh;*9k2b6Iyu1k-e9 z(0DyK&e@Wr(Mcl68y7W3aDLg**~9wC`zp0cusjC6)Yoi~VGZ=J8@12AO+zP5J;VH2 z1^m7KDOq_J4c2kT9M2<0tiRsA9F@(83r3vSGmLeX&a2zXECwzM7QSW-zueh4@St4^ zocs8**8y-XOX{*xJM7{zR?brd?qLk@ZQo{t{3qL$wKrhTB*~~-Q=W)xOZ-$k4DPYh zH@|a&gSNR9fH5GD>l&u~cbBunM z#`hoTC)`HB(H{=)8QP0;ezxT;Ep# zF3fjc2z?G6x}DSA?IW&JgC7&;e}VsJ3;0D4_nQ@Q%9Eu-K2};*)8VzQgz^cOMPDjc zLN;$k>g57>D4w=y*B7jtb9<~}N0FDdXL`x87we5)IGp}5o(pU~;0ic!{o>Oka8FXNag7YPYX42e_K867xzOEo9;~}VZ+0xyqCD_3VG=9tvOmpK)ZAflw^)546C>DVnP0jmXnj<8b-$7To8*JRw&1@7d61+qS@;Fj^)J zP~$#zI$dwF0X%ii^4Qjm`p}nF&dja8m-2r8I;$pi_$j#n5x)I+-+;@=wGt8dsf^!6 zgY3B9xBt2Km>%)F+J`(3X>lLcUiUbO0eM=TeabJvQH{KZ5|rW3j`8j&)7^vT-loq{ z95}D6anC)oUErMh8+Ju}$j^zcJhT`68(gUnTY#Tu`o-;V9$fhAW%L$XLA<9xVI+M5 z=Vj{(wg+VRXU^NICrF47a=i211wYVS?zEf? zuG-xmL{2+_e4z^J@l12*PXgmvG$^+T-)iPWJMWHe`^;;J^9ISCu|WNh?mg`Zr{Twf zw~J4>Vjscc9fv|c_?_NlwFYn$<5R7t58&quT=uRvw@3bw_u=TX;JO>a^Ub$VMq22Y zNZUa-+-xuN4E}jvZ-M7}aM%ms5xZ4?*Pr#3V-S8(tdwT&a2)dWz0|(^iO2Zry_1__ z@IDOR#W}Tbd~RHx$`AmZfp8qw#khX%;|{%Sg}kuewM`@72=!9_OMPnKwtMAIq!i%a z9xn7INP%y6$(z)HlfNjf`8~@4ZeM;{>7lB@ByNa$MoU->ZM_}Nuw-oB>tI9jC zO@YpJb$ntWokR$htk^c?kcdazDR=HdN9)|_!PW^5l&Lv3_XFoiO`g0hg81bV|c!(^s~)ju-iI$vHJz=60> z=wEv-3e=@x9%uPIBJO~bQkXWjJcXXRtI}oLB-Y#ANY*#lzqpM$%Agec7H_}pnXnLb zCE~?W4>wD=5-mom$|RJo^(uiqJ6(yo)cN82J6wr5`#q{r$h#NIm%4n9!S7Y=dGFRvnQYre{T2>M{`RuM($U{`aG?6%59 zyjSe+%*qAmf$e#s;^=pAd2XhY7w$v9)_+~Xcy6m5)ZoW;^l(BcMF(7LQx#NckLzgs zag$yd>X+^GayE_t-}M;;^hd(p45gc0ajb0hL8s{~c=bJtN;$3@z25S0tw7W>YhYUR z1rHzhe$j;X?oLl|=7FN7oRnwoh?;2u$%1*~vpXS4J zdhgHbgZsi$M=@GWl>428exE%E9;&fW9zwl=H_x8% zi-7~0GX*2yH{x9Fc1>|2-cYwh@&-?>54_W|1%Bh=`hfe_albbn>+${zzc8a&-?jb_ z{K3-><0L%43;w(%)4db>`VNiMO~T*QWtaRtwHf?EMpz7f=)~{CI|T4Ns`JeEdg~VO zVU%5r-a0%NXZ~*ag*fB|i6I6)@YKVEk{Htg5-~~=ddY#ZcVb6S2J{Z98b!4~@R#%) zhm1UsuYF2n!8H;4->Tfdy*mZoih0(*I}H2gu35i*^cT9DLf5msYvE6i9Uc*zVnSSE z=fyh&?uXB=B!q{7ue$Fn3H&ky-$|`6PXO0!XsJuI^nk7)Kk?HT&)2W7O$BD*SYaSP zGz(l~qkQ+659%ee6eVYYoBUpV-OUHiGRTP5=R6L7cZ)jN*g8DnO!^)O(!OM$=)jL}dG+gs0Or^0joosd2>f?fT-qWt_@i>mWHaJ+mlC<(4)uV4 zBZCASs}Rp)cqyE5lSG8NhVm6%A`$lEaR(RUNyO)-E3!MmSKMur+!JR>M6BC>h5B&l zW?wT#uf>pv6ZPNU9R*)8gsD#qgU>{_I3FS*UU}=jz(z^LC&Q$+QbnS4O|?rZM!8*l zQ$_&dl=ihgFT%@7#Ji2O7e65{>{ncO*YMdR zdtu!CFGBP7K@VIm>W+Vi>o7Ao#NQ3PNqgvMhwvKM%ks7BEWVd0ebl9j>vI3^4X;<9 zGt&AN8gp^3$g*9$3D!Xty)Qe~nSsty>=CRp=FMAO?m8iltm4b& ztKjh4;Vp;4BcX5J2zEV+b=H$UcvQ6#c~oz7g`V`_dS2e(S@a$KK1d3G&frRv*Zo{q zhJA_p%4@hicexVp&F?zz1Xr=#%I}oKvGs%F@_U3_35Jy$O{L(fSHA3e5}d9?+dT{4 ze!N$LBQ&{p5PDmbY)RawW$Z6t9x+_t=XDejU-$zswca@;5tj!+h|-4PU^A``XZ0#CJUu&^CPG5+@;yNln!pv z=PC>Og?6r;+#L55_S&eKAVv>vYa8>Lad1bReYl~x6zwc8r|GT1b#FP^@2zqKoYs(b z{}=9`+SjikQ_ya+i141ZgXBgC`C2-$bbUMTg|9bFzW>+8X@3GSg z_x#lmPl-6nTmimPq>Vjd3_m5T`u6r8LBtE|gSJ8zZfPH60Jk)4)DuM<@(7VlPR=%O7iA_xF+rflf0e zkwN&&-)ask;4B@#LDKAN#FY|GJ?RB+l?iye-+~{#8El=l%4c==O+u{Eo|oz_{e6f# z{md6CJ4}UsRZ72H2R~*yL-^mrxE~5lo z!6uIB?i29$!-oaKO^_#D-Th+!QRpGR1wy}pyJWNPh84lDWU^?LP+{Ives+txV|_F& z)`i;BgP$do5{Jh~#D^0V9}J)$i4Nyf+$xMELD#2&lzz7mF=h9?tjloecMJcv%h84&`mD0_ zjw1ZtThk%lCwNXMIV5>*3Vba}&h8=i3r2WK*JfsiAO0y&)v%C1{M{xdnA-cf4N$e9~2$tH8 zxc7+O+rP2kPuK0;ea^UE-TPZV$zr{e57>B`g7?OT*)4SN9H3>Kq?xi^cP!NoL={U_8%ksu0)2 zc#;_F+aBP0E6!+qUVw3y6)p^}#@WlyGHsT|b!NAaxUgjL|MhGucVlp9kiY4i7V6io zJv6TjZVTD;es4z zUbr7r{xz3Tu*UpnOI=*mBg->xToc)eeKBlY+mcwI`!i0^Z$~`)ALueDU7}ckVuAmn z1*l`_=+DA$2+_O}qDDC%^YXxT=rEFMt!Fz3}6I7$v@f;jcY(4{jk`wbld|3kb zff(WS+u=uS>(sw&1ur!&-$|F>kLUFM1piDNXKQToeFOelE4~TsR*cgJb!YTUzARb~rvQg^5EiI=D~M0ng$7O`>^Z za8=*TrmVkA$V(bg-&zd+lv>JhqJIPOginq1q@cf+FR5M<=zsTLo)Aay(Ut37f7rlR z-0||-`iS#8Y$KkPa=fP!v2DFDpao+K*!9?GB_*2?f zDs_B_4;;0U%=mxoz4t$tZ`ePcmCVR0WJE?8nH9-DY1APe}aGeeD}G7R{-{vcr5l)5Z4Fu9&=#04&2rA`}7^y^N%$Q>FTiKi^qP_tNQ`R zipr7D#^X8nauUTVa9kJb%7Js1s=f6!|p+Y~y&h}-6S;7ypx_j=d^X%Tz+uDX-BNO|1!@&VO zrO#V1Z`#UoTDL5ginr#9=?nP zZrXTwjsg7EIoCUtS;!a0`Ja4TRtY&$@qN#O`>Yoa7mT4!KR4#Dz##6ox}5arCF;ZK zCHI`11n+gJHOiE^#fhLSrmI>8c@sQ0RQ>Z4)>l?uC!g5_Ub?_veSbgvFtraylLYFj z9LM87!LL^5ZMLgx;eA(B)N|Cp`&2&?vpNmjJniihdkp%MagV$PI4$|UYfvFK_@)*g zntB%CB_WknH@tsQZLePm_}aKNPKr;63y7*eQS`fZTD~yYJ+~3mZ?V?1tQ5Fgzh~8uD&^@xB>VEY{7wDRSDK2fHvYS>F!4X7JRc z^?3`Px4(L$Q6#ukxmQhY)WRAw20pzwd}N+<1>V z%>DFQN_bu+-N4p(E8-o8J4$@$N7Hx9i{o{u@A4P+D*$c_4B)glm5sRObwkleBKUXC zv8eZVVF!=eXYG6sRfm5MVUI83jp^sVe*;&|XOlf*hFo7#aW*Z1+>dRn9T3t--qJqT zCI)itSrhAM4LebB*y1toQH<|P&KVBKxsLRcT2jOxWDmay?Sb4-Hao^0R|KAS3Q$?l z1>c`@m|xNgcH0fC1wPErm}n#qy> z?@n9(1w8*hbQAxb_TLEnHv<0;Bao!=xBf5e>`$o{^#icKodf*Q7B~*w{x$y(@p7f~ z(kn{nBh!br4+`waM@;H)I0Iklga`f3mxcXJwG^yYf}gv{JL+~0>&`lzPkcR#_&BNW z=>_~Qwf}djk38yDV*-w~odS-1Q@&F`oF_?2#*H?~jfG(fxXQ9d*R2Wn zw~N}fw8IamPtjCOvw_$8ax3oz{0a&AuJgQ1u$K=1#;NIn#}vH2e%yole6iBe+Z))o zH2W=)8tSU(3oI^CfS*#=_uX;;t_u6}vgJPNq1AtOf9nRm`qOR8N(USzV;;|Y0>|rt z36;HXz!z+a{w-;CA|x(Q2+5)voc5O^HER|3j+fNvOOg?OT1r=5~}PR9d}mX>wyOM<=UK3LPZ!xy-JvGxRS z)aT1$Xo2G*16_whIFG`o(uO4z{&`zhB+ncCpV_QpiOV&@`*$pXXJFrnn_I%%;Lmh5 zxovrqfyd6*E7Jl`m3}{V#`hg?D!FXZ#0%7q3{#UIt^`l@f%wQs7S?|@Fzr{t^CRB` znFXOOrKs2T%m;7S`deqV8S%TorT65(S5H})ikL>>cSK#fj^Ws>)_jQ?eu=#H`uT($ zDi!x>fIoCs`F*zpX!r4z}u zT&6}R0{eh$ND!FXjY0glVX5>C=I*P5}gQ2iWVJHn8&+s-1;s9N1gw( z?wnRWqs<8|oyZD-&uLEiB!pM&6Q^&~mO zNP*L+FI1U<-(t3UVr>H)#nZUAZ4>yat4nd49LG)Go(#fcPK2P>wmrPSUk2Yw=bl5) z>4$S?k3r9kAB;=ghrU!kO-rsrf6u2R96m&Zy1>!P-I|n;%Yefnnb0%-$2M>2SW!px zb^3}6AM(gFqNg}84=;GNv`#7jUk}@l`ar%ftg3pnsUZK>-QIIX75%KXJd=X=C^H#3 zB&UUVqr{Zqt|9I(PIm9K4dkjmc~KgAKzEPoNp%S3KWf=}H5&69o;JMs0OP?L@6MA4 zxo%CP+*1qw+V9?L8Q`D})~7-`6To%K&JCK2;9a#7JC6ZR1>1Tk^Zh`6?)g}C81RK z%{I${|B{b{zbeK2>0LCz`80_aueo_Jf}tAP(EUQ(wcK74U+QXYC0vN#&k z7zaDGo56AmcYZJH2qbDHHUUwCU9}#!GHV*pUhN zD(T||eqG4P^Yvr5?{VP1CIy0LFyDlwx5h@mwQIAL5`V;iD@*<9{D8CQe?C7@484f{ z-tzr0?k77na{ihz)~`xhhk27({K5!{d4{>M8XGSp|V#r&p&egA)O z8UJ1K-w6CS0{_Diuq?daejL1&>aoKa3h)c@joJn8V2Afif6-?HPH6A1lS@JV!PdO1 zG#_@BbA4L974cM#`^{_3u>00Ne;(Muey&>Ht)$aIysD#LO@j9NOanhF^gDd-X^}!@ z@bVi1v^A%3{p??p6dA;O3z+KvwUFQY#aH{)3w~F=!dptH8~cfS>l(BJcMX@?il(BzMvF5$i}@MyOgBPj zT;VT`MTCe+(^1Ejm9d_97x-x+eRkB_iBPEd{Y#P~*0%-5CrH?%KHB`n{KEMC7&h4L-FBBA@xqRump7f00q#jv&r8OVd7nkdlY%c-7iifqx3~CSz(cP`AF47Jo7Zc+Io2&gmxV=YEi$J`UXC z<1ZSz4S)Vd=!%Q3EAUL$Rhg9ttgq7BEz$b zh~tC*h{+5&F%LZ0w_8t{9)3jZ?KnXI{%|GM>Vplg-*R|QccC5gZCF1_}%lo$c0M-x*F!oPEmJ3jmYzi-|r=FN2&d@G*!9Fhc_47lr@WR?jK}Hx=Mqg9!DBd_ zvmt^!mEBYw*;$v8u%}LW4Eo}zV$I7+4xZ9-dZ=R+cyZW>oOK>?ftlgV7TUIOrtjv+ zdn>(tu&a6z_^WU$;tudyok~=q3-GEiBd4#_ZzsZbpsl$Ga95G%$h0`u(Xkk zGcDkspE03gkdNl`NpsbZo2w=sj=RIb7hNm!waWyL_2+UvVT$F-7D*cJ|C8QuvS@Fpw?>_nwGGL;G_UVjx zoB-MvwgK_Gp*L0nfsHlLvlgj@V-lg@Grz1IEDXZ_9kdF669S+omy9J3-hka)J@@*w zKlocxo01O9zsQ|HK~7Kbcyhx}YaO5uRP2P4rrs#2`T8)vill^PB?a7{tXuT%1;oR?9tRwBP!Do+ ziJumDE$Z+dhDppL9oC7{?uB%fqkVsp!p{i_SG*$gdq$04c1n!Avp%{A5$?@twP|f zC?c8-6~RZ<1jU?zz0-*MLKdVC|M;O?VGepKvn_d>Uk&k8j7Z8;*u_2l{!8Z&M=26b zIQWTSy_wSRxn2?YhZYCwT+)8+AQfYug*J-<@w3+HbHSk0Q(Q zdJy&^LO}c0d7RHL9^#-b3SLbo>>>&524&RWPdoe?dr&CN-@S-Wi$A^F*{8|!O%ekg z@*YZ~!WNdmjeagnCdIwje{0Sr{tEn^vZTSV>Qm%HV^^FRbDRhn4B|yq;i%&ZwS7qM z0z9-eAoJK{$M0%Bti1pp;7bQX>scqlhDVDBK@E8s+QGU$1Jq%QYJ4~Vyd_umL|`ib zc_U@lT@SI}0QIf2+V0>{_7Ary%fPP&-wjhIrT}gX*d?uq_fOP5AN*V$cJ_QJs!1FJ8eP696|d||9FxQ=nTxoJ^k4W3lYkF^T;;&Ut0)qTL98=AEHoow)4PFBZy z@jsip-mWbCUr3d8_Z#Hy^n_k#v?}oC8by<;9QwmRD(eF|NqzP%gqIz-ldF)JduQBJ zDh7!DI1yx-4GA<~@cn?r75Ac1$oDbcJ{QPEf4ZS<1M0qnd2N+NAs36KAKC+ew_dme zsVRW3I(S8YsssF&2IU3yv%ph*uR?;W?f^fzUyGu^alazn2@c>bx8k@DG&nz}mu9rM z68mjczftZ6p1)X1JaPIf-XBL8JD1M|Nj1}D^>!&{Y@X}0DL)- zWX?AOymsql{fV7=#o3cf8FG6dFKk~$Gl937({%&_seu!IlXvaZfe9|ZdrgG#`Sht{ z7cI`)l}P;fH4W;Q980K9AAo+PYJE5fJxd#Y@6QfBwy?j$)~o>DcJdAWZxvK{7vp_dr2>dnIv_ZIrCh#s_M)V)xs<#GT!g_!Qbf}o-?;XYZ zIVP1(r2o-0KWCn&BxxT1CuALs3q-nCZzqy zIrA2E^g254exJuWMZciu64R)sj}c)rq9b-DxDl*5eyu>BhwEAojDv4BI^2``8u8DW zgu5h7=W1FsPuND$YKq&wd?(TtuUPlrDc%y@dxjvIPjsKEY{6?&g~`otC^aMI;9*+Xc3-xSsQ;`fH& zd96}hN8A0*{0DH#=k!`P8Q771KS^9q9RdF0kmp&zeNGIvjuN5YRdUiwL+~TrdNb@k z;4u`de#gHBKPRq8^j-^fSnI@{UV-qd+@BbZ{DME!l^;3c1pYzNv9poS*NKoxldv^m z27V$idXefJc)rac0l5>vOO|cMmnGn@DdbcraBT8#z$-)v`#zknyv(ePHaYcDCa&|$ zJ)WI?75PQCLn1G6Keghu;al+24>OWSo4}7)IK1nkMxOG0>*T>G@C8q9(A_RUzd1=y zblAe5nZ=|VHpAZeUVIm_V1;$(ys~%t5zjWTMx59RM}F<~lclH0u7gqomUcPrVnK}gZCdI$q{c+tLTDKJ88}JL9RIAN*cX*h_&|(;_>#;sGJa(T0`pGLwq^y#O{Ezs}?$_{R?rWK4Q@GC={rKJF*TA=JRRw;r zgkKuHwe4w)x@%v7Ofs||zpoz*H3g5hY~sXahWuPFXR^EraI5Eqmcfgt>kcqEr>F(K zCsvw3135k56-Xlhzis#->h&JrvkyreI#FWa2X0TQWkF6mu9drFz^{1v+nEco0B0<+ z>kH7q|E}MV%pd_ySv-44AMwZ^j+}cDn8$5WlX!o~(T8%wpaJk)t&E>lW6)yYBMN6?45-Fn;X zs+jL9w?bwxPDPc6*_vIz8@sDL2}Zk=>F{QcHQsMb;gvS@H=;o=B@TE=)x^)<^c3*b zvz*9H3HVoa?ZQ;(74wbY2vO)=#u&+|oqb$t5{6TD!|$p&vCrOtoLY%quirQc{^gdA zbU2PF&OCoSBn_NjU1B~g1O1l$aN1e{*9nYBWT0O`BxsR{41lXCVwtJ%f5426%LB}7(zEQdzt9fNEZ1`5|4V&NVR8vP zFI`HP8hEf8g3odyzV9d=Pt4Z9rD8zS)RMej_(h3$XNx` zI}<#li&)FC?}UkyuYNr4v-bJ&+{FRp*-vdwOf?~XIFQd4oe#M@+wkZ#^lj-f(Zb&_ z#H0TDD!c)Bzr^xMYj@;lNjJ2OuLA#2@AeR~fIiprpKs7coFpPs@)F}MK7W}hSRB0n z6wkeTz{z>#7KNS|mmtrOoDxB-vs~^En~}u)-d0II0GwW4?q;zI_J-ThmreruBE0=T ziW=j;dt7>J=X(dfDxUY#F-~Gqdwb`gN3MbbE^HY8-DVYUl$DXkC2yIM!*g>4Rbq<> z$OHeob)^UT<&|L)wx|yOz&YCCkNZu^9ky?WJ>zIDtCF+FI3Ep?dVd9WOZ8Gxr5W__ z)EL()-a|~ceD_ma?=*XzYZmgvZ*`@@8uIu*baVfm_TLEnpNzo!7uj{!V2>&liKeNb zf5j3RJVpGlJJOqPB4K};hx}`V z6dYgCgMEJ9>GlbF*(4fxYzlfR9eHLw7J6%v7C_Mid+fQa`;`DY=V7zC=MX#WK~wl| zRU9X1O_|Da!d{(xAGO0dIh}0m)O3diUurop)l$7ya6pxFH8V>kZ*+7tTAuRS*)Z=S1)i?r<*!|3zET z6Z6Xw`>k$M8yYzv|H8rIMe2_{ESW*s-utKvGjyY(s>6AkyuL-?*+jX@6~2?g{@GQi z3FCb#D{?8BV6Wav2-fMtpRjz}8ticdFB6dDyZ;vW8=pYqJNGe;6<12WAkE_fpDH;z3w@*a?A6N7L)QrUZlo!(<$N#NUUMWVefS+F{`pLmBj8T`y zzIX{gaOJmCc|P(U3AMdxQQ$Xj2vh7qKc&T(lb@rV4-K@_jzb=pNhv$62zdQgQ7$|D zR+L>u&bvnJ=b_m)zk~m_*F3Jarh@;_KCF-czw*1bb8=_DE|H*ByLc<$Om&KPhhXOu z!z*4~hTQ%3CLfI1vB$yBjFf?z&v5KgqefsiEqf@4&;KugjA6l_xT>b)xU2aW^Jt;@fYq5}`ce9Gan3?=51f5FX_34B$cJW(+G=U{_j<1qTEnAW1b zigB8X&u2V)1^GyYM_=#T0xv`lEZo4jFm6s23&2m36V^;#!jDPN9&<3pb*u)B<4e-; zhtI#c?|fHVVb87s?$g*e&Gu9rvj*13s%MIi!=FoDy&}Ey9n+Sm9_t6r;GZ(`zRjX# z-&OT80qt|KgYw7GZqYiCNL~ZqLX|ei1NqIg_c&bvK8EC&D5E8K9Si=ru!F!?WFn+{ zSv@zr_{w%+e!dycDW*E1%>^9MO}M75?1JZ>tt!xR1^=aFaFoXha;0oPbi^9? zF#pZ01MZ`-POMJ}c`$t6eK$r0dg7Hh>!1WX5hd~D3*Ix~A8|4{-Xl7>w(c0l!BKbk zGt+gfCphfmR~iDmFeNIakb-fb%T|qn{yfn5qm=y?xSM>E?Zpgmg`9@%+WHQUo?6sL z>rAK*H%`#za3+wdW>ZySzprzFLDK((oCzV)Z$kE9KZ=i;)KB*SXO(Sp#abQ!zG8VJ z;)Z=J3g>d|>erBGH0!J=m_M(dw(-hRVLpIfSspX2-0 zl7YW6|9HFI#Jny!X#H4*{@&Z*u)2itwkHlbM&Si{S{k3<*)O(VPx5CPe&^gXvA-Si zDq2IHI|IG-cb)M6tp)sE+wgZM4){NDn*TlYzY+K!j=)FaLW&&d!M?G$q7g;t&#!h$ zRp6)0MaI9~qR~JIe?RPm zyp|j#^qk#j?0O7-XUo#H*QJKt3moacO}?{#;K%J13iu11$+r*a;qU(N2`wCee=f?R z-`SU$_;tSgaUS@|_lZm8upc?SlURa-c(zjWkpk|2yUZZ)9IlTZA+mJ*iM-5#6SGpN z^JQ14?Y!85I;+`8`H2S9Pca!P6y<_%a{PQnBoy^$fuv1kHco`I%$p;7kq=xfq6zns zbs`Mugk0JH&SHf5DwF}AK$X0nrHFNF8@GcZ&tpH+h|`B7w6O1mucVR7MJK}d(fTVc z=GgzCe8n*zJXW2j!CN2Ts~5o*Bk}RbGu5W#Ho%|iam`jppfUq%4vI*_ z4u0wU^?CI;>{frL{wvtc8J4Q_1F$;}CdhdH1^`z?c6?Zc-DO|NI_6r8cv1Il^qorJ zF^ZRix6p?8(|(nG48ErD^|!NV7j_-DEyC}dV=b|*z*#3tN$qOU+6LNh<2o0lsIG^1>=I+G;oIi7jlOJt_ZCI62Bjkl=k!55I{h$*%@nQ*fKI6=y#whR> z_0?+Odc@x-GRjOxe%P&Ek~J1~wwuOJ3+<<0(sC~|P|sni)l*Z0yvM^33(0oyD@;Gf zrs2N?o0-jRTY#JUul*z|0iWP|fH6EC`IO!lZbQCUKRQ$JBLV(+h~ZoiJM1~7k({x= zI_5i=nmrHp_gkD-=gxPqv&H6mJuKi~`7WK@`3_JLliq`O7`My%4@Wiakw-Qg`LZ9l zz^35t^#gybT7^YFQq{K=q#xZc+l<>NzTAmyKXvt?Zmo8Mh~kg zBJf&{oz0sbMaU!8PLo&HI1$PYs%~pR4gY-pgZ=NL+;X&r zuuoXRq@30leAiJ+pI;HUF1I!b8`Gj*`df|G>|XGD+oHSm5nl)@W%_r(Kc=K`1s;N) zj+9ruUBml(DY2AOIHLbI?{DnvL!0R~^ft^G`8Mn#po#GtX7f(?bq@L&DQ;V?4F33= z+R0AfkTZghcpk$q-jCt>;tRQZO-OUCPlWuLy9KOg!{2G&s^)@xu=anXQOE}$%9!%Z zEeqoo;4K~T0Q@D%y*BzeX-8T>^h{T=rcW>_}2YZ}I^{ z*rlmsBLV1N6-OgilsD?Rdyh5l?DzgeYq92J3i`!jHmaP9{-{2t7{T+DW?Ck+(2t1K z>8r%h2R(Kn|IOQwqhR8&cFbRWPPdaN`Y$zoylm4H_1`>tHhGqa6JB^eVnja_yQuG3 z21DN(=gxh{_51FvCtfK<{h~msPH!uoHx?oKd&p84s0pxN zf)}3c@Kh)3xDV<=uZHdR-1&*twlmi%LF%o8le+hu6>iT+{azEne&#c@wbihS2Yh~QP zO?3ilGVd7>r;;Dmbl3;IqqqMg2b|^gPu^FQ3~^ngf@c;n^mgWW8P@{LA)^PyLY z*LlM69pqL=GN$WT5C5k0TBr&9B{^Y;L<8&3q*`P5A&*$U9Yj-xeBqP6p@;Mez-exu zyza?^Z!o^eN`vFQdvh#~;=F^)>3sWjkS7#rW$(Cz^=E1EGdgbIHFEY-S>ic)FRp4_ zLcZwIp%}(>_+cS>|7VXnod{eJuWfoi<2%{W0bhN0f$!>ZG9|&dQe}iHOpCyt-K`@v z0nVMmKK<7*AGxa@+K;azKbtsu@JcxNA(xLVmopKE4pv#sRRI5F{*xGZih7^5v9_5S z)N^oV&lJPI1WEm(DTe>bANbgmj`l2z#a`=T%r_C;#l85SRzP!nyA1JjP?i!|6>zmv z&b`Wd+-K-WqHQDi5W}xi?l@kcswkX#hJEHWJ#c&za{PnB*TvH zJtBJOwH@SDYXAP{W~e(EX1ZJre_`ZJsmlg`aP^C*`i}qSwl$cXg}=A6D*RRk|3F+- zc{tq#c{GCCuCwqH?P(K{2Z0+_qs=__!mlS3i``-X9vIV&8>@?g-?4O1xf2Io!6f$l zI`CraX*Q30sg;rr^O)MWJF z!T#L7@!~`ic(%CnMziusF&=YV;#p(g0Jpde8>BQ(TEsuzWVd|biZ-b zlV!b5IQ13x=gRUuf%qi2ql#8&7y6wiB7O_{*DtflQqK!q^&rUZh&<{79J{fs?>Lt>}EH7eS9y0y2GQ@oC*<o=<`Be6Ly#8ltAw)Or+|&st$faeA>|w4&d6&%xoJIr0`+NXVjp~OQ8*J0h*cV2*g)OD zblIoJi-=={yZ(w#qK@R${u2R%h-Y^FVe$tNho_qtl`pbd!brbxGN2k&$%vb6= ztutd8(3kC)i_)=pFZqqD&u+ob?2D}*fjm6rWGLmv`x5sZ57mGixV_ue-hgqS)wmg9 zt`8h*KC>yVivMZ6f^NwoPGl87zLS@ZW~Fo{<-_<3Dg7!tw1cl5)mm}fBfvs=N(_GK zm|79VY4mTuy!j1W|1yBbu?_ytv1Kto5b|k9ZfhyI%WXn*z_mR9H>Tt}T4v)Y{7{>j~ z?X)hu-w;;{r_Bw>kL{XYmmA_-nycYdurq({)){y5-2W#||G$U+uZ=(|p_H-?awH|C zq$Z>X|C9dJy{ZQ*N;ZB!LitSLJ}wTr<8sMwYQ)*ejB(6+pcf{;@|j`B1x)ux=p(P!qO$)q)h76+ znMVy5$Y5Wb4?ep@k2qa~KA~^h5^y4x^=)RV3EmU-QYx_H!b5%oAH}IpRBdw0$bGme>a%;=be)L+txVS0dl7 zj(s5m&yrRWP+#L%oUkJ8MA%#qy2~nsb&YhTsnW8z4_oj=u?p(Kf@D|}P_I?|@1;SC zH|pgzcp`}&V7+75gQW!EJL#>!_-62J|2}BjrcPu1mj)rV@;AOOLno%W0i4KnpFHn8 z6Xvag?ujzq*C@4JArE$j{8_^^_Zh6ybC*38jQLsZz5NA#=9tGstwc8B z#G{KkNu}@;b@QzU9szeqDM~qIf)Ds6zh($r@Nd0Hged}iW(Q~eo+#w;l!RrP6M@$( zyDx6Re{{|j%B|#sm+;d)Lx5lLmAMhMv!8Yat+3x!_&dWtuM|w+58B?oSD={#t{oEM zuEO{4hRjwOmGK>wG!l~N{qO_b#}!$AEu){GP3rda@8o}{7}DXdtb{KIvNhxVvR>Yv zzFkxMX7yWwi z9QF+zw)Cz5kJUiK;J22K{X^dW{jvBExO#Xyj4uW2AFudIyiUV;+AsBX)@iha7le=$ z0`KcP&O4Suj_+=GzC=BkIyZ3-8~8P$Tb{3!D!_YH<<04!^-I>16-PaPQL}lQ`Ag)% zrPMh-bvY3@_i7r?4Pbqw&jnBJG3>LOlVRnL{@l5lR9p<4^-AKq3@P;VzC_=1KEyNo zg)Z8O%7f<-j<;krgZ_4&os)r_=|n7-*W3W_cl69#xN{O=`+C9^6u80C}yojq^ zO2GK7p0XO+2Y?_sCRViSij-{Um#!D_f(>TCU1O2~JX&^NmmY2eBF z2PTT}9O3#0W*hK}od-OB+QU!MoR*2-g1nO-R4cH@^K~trUj71k$$6LPr;WJ7&gn#o z73T4)cinFT$Td;a(d3C&sQY@{@sk2_dR@$%o&xhe@AL1sI&g*1_tLvXcwb_YE4Cq) zh#OChNoA^FzIV$!=#c?VOg|UB`y}c`draCS6%cQ{_U$y)f*s4#zO4c~s%cW>e-1cg zj-1e^4E_7qED#im`^vS@lb?m2*%6gA9C!mfy7jH=`Y7Tn3SW{hi@=p+9!`HZ&~lNT z;lp=^G7?oZ7_d+N3HF;8D3Gt*Vx^a+7k4JKu#?#PiJ?BsG>Ui>-z(B1E|Dn0zWao; zdgUXi6YHqAajHdq8T)&s%k+PM4-D47>nuTzYmPARK#wa&=SKfQ??}!iiT?cnUhVzJ zz%z`;oljDpqt(E_352-zT@#BYtA3Il=e-gW{qqF#@01)OHsTIDW>f0lWcMGw z`d#)2Vtha`^(&Y7UTT9@Sb1pKnW zLxLeUaMWId#{(Dee{iGf+$C$|>3@^x?CgWQWHrZ71AmkzE^J{3y$IP&%&cS&zwBOl zuK+l#^_O#=9`wOayhk~J3w9-g~Vo0l4Ob7pcaP$5&8|uDl)=p=0!(YY}OBNr3 zKP+m}OXP%{kEdr0uz>%!RMq%L3BS(a<1-1o_L<`QQE}vTbRT!*QjefshBaE24ZM)1 zbkE#<#Pce;@5+SXj~@E`92J9KvtE8>^#piF|CoT^HQ=j3PCltu$oFU+PQ5F81OAQn z<-}`u)Nd)o?pd`14m=ZBf5HIx$taMh8hlky@z*z@$AH5=(q6R^#QOc1!Ry^ZsE5{C zC^ZDmYVTP#zoL)*h>o7mISG8_`HttQF8n5~52xLB6UO5ydqd42?!$5}L~s%NX0CDi z6Sj8Nclt1pP#}&Ix4gac{lo!$wbu~ia%YZDtpM$0lwHu-5yn2Zz%l+YpPJXaGuS!d zH(N~tXgPR$+IQ+F+;vV)(!ehMA#8nAz;#bQd5&DmLY>ZhtBqnM{HmWq@&(|ctzIAN z)9`yrs;{_uXOX8{3MoDf-m2-y%84-8eXphS;)__%B@skjx(L7U_t}x_dGMb`2md{? zf!`qZW9(M{2sxyX_X`?A-HX&0tM_PGZX~L=kHF70R&SY(0WYTY=QQDbFRCY(3UPjl zyz$*o*!?q?6W$(ZM?J?|_ulDR@E6+$_3ev*=f_O-q~S;T&btPlN`ZYBIJ|HRcGAp; z#!Cf$AlQUREAA%#cbQV}@`YUMuX76f0as0w`c{R&&esmCb0nibEt#9mPoOs^u3H5F zN6v;^E?u3*^^q1o^uJ&{Hd9yQ&|e>hT>AU))2V+Ave#gLw=*6lF+i^}RUdzp5J8;s zkB2IW3_S0-yLCFVz)#oo_tU)xA4=?-tI&+~ibStYchzB?#AXivky_*(GrIqbKu(3Z zn)o8hu|J#4guGIb6XEZ!;64(_?G3`^G4VWn|7Z8Lj;1W+7t{7SMgpH*ZcvY~13u$v z(zo;iF0)X-u*U#6OkTCTmKJ#K&Xb-#$5-I5;;Kr{;`zQtFM4-F{zd{cUo|2g@o9d# zO-c&C`eB|!ffsfm^=Ezx{9d4Q?PFbQ_#N4P!!+0z^Os!ijF7LDc~$%86jPZVAxExg9>{l6CPVqTw_ z%2e#^7kYa%E7TnAzl&|MJn-+dgmGDwZXAcF{jP08om^t#yFI``Elu2VOBipV%Z;)o z<*3KsLt|u~k99HRqYAuu&i?#=^zy05Pkvp>DNega(C72zr-A%ZoVTaY$^kF&<>-AD zwB@0sNk;fR`;Ng#I^<=KOqo?dHvIdqh_iLMz|l#pDcAA)d)KN1WU;Vgr}=!#@cscR zhvW1w;{GR#zMMY}xjdpgBn106Z)?A+lmYxzGnLF3^mQU`>yZdE@YRrzpa|?2bFrU~ zr3Cuj@Z*ZB3gTOH!rI+S7{46ZvmO|~%jx02s2<=w9W@+`tAJ+(tdpuCcY7NLuiMN) zzPu#GDmNj|cl5vM?E{ZhRBdd5di(eR`(afHXY9j!@}!!KGa+S3{w_6I8dX=<8vLI2 zcJ@^@>c_UeNivxt-?`BL@M$uoGa+`IewM&wm*Ge2UP5eg_^a*;5Ap5OMnUQH*P7evw%ea7THHs{TsoPJUVaKsE462J;{L z3n9R>M;pE*;rDu-KEb_r5VsYPo`{3}(c_k>sf7IGTK;hV?FfA{ze;x02+xfq-b->8 z?`!-`xfY|P|Jfi%^eJqQ3YP-)naJY1Ku+4 zYuk(QJV~Ce{nH+GXs7F0f5LAOSA2F3!uZBqYqjA={}fk_j#i>S_DYqyjIeJ^yBORH zU>}AAN1XRS?<)=Ww?D-DwWbJuTTRFN48{!g;rP> zV&(b;c=G?q?f>`K|D_R_{=vR%cpq}m!0;mi_MmpHZ0ZN>y&x&Ael+B2SB(DNG063C zCzauQ-te<#U&xMl!SCIk|Mdp#c7tmrAME9wz|o#a$P1tShaW$19o?oZksI`)+@!|f z6y)@FPJEs5W#BKpNQYGg_(6TI^<#X<7h2lha#Cx7^i`)g@4G30+SXE+IYK%2zUwy*G8_uqWDlRk|7tNi2ZbdeAI z^g7*%;SKm9*>X`~;F*yN-w67M|IGzYe53--`6E6}u`3q!%ijJ+mLk9tB<*(Ex(h!; z9&JSv?nJmMWNR0Oe9d-yRNQUgtm>eZx65Y8yUZ67jF2Zhock?kTp0B>WaWVaJgAS~ z6QQ%rhhu3IiOl2ZPp0R_XFcq5+JA_+8+AKm%JK=u>DZS%QU0J8`ZH%6^g$nd!ZES( z?6tu$UHtXJL%@+_^4+ae7*Fb4_2ZOp_w0}m@KA#ccQE%^x^&h=NWC_ zztwH!Hq1+!>HS1L$o07`$|_346R$gtFfYuZE<-zkrHScU78**M$kfzxbO-m*JC0Z)4I2fIA-lue_5 zGP#jQzv36Zc$y4#ky%=@qN14hO{35ME<*3A#WtR~0#94?Hy(ohIBMriqyc-Oo1{z2 z;0!x(=vH{01OBghdCVWjAr?>DzQewJy#DVVLnwH}_3R;AjJM(b>Y?w&@L%p_S*Kf( zw+op+a$^8^Y&ADaa|-_I(^=O@jHmX$V1p^l?=9-Z7>nnKvoiK^@2*6hU+H6oghJFk z=$}$;%t2gN*z2}~f9@}Ca8F}i`Kuq8JbQ>bv;8-})B>j@bWpjGCIBaW@upXTAI&3_ zjxfTG8U4MxYvcyxqi%Si(g%JvFvI#M+VlrCCU;@?SY)YobHMItT<`i369`tF#LfiX8*VGkE2s-u52#MV_!s_B zF5^PnLYe-1zZvw(s#4C1^cncd6;r>D(1*Zvw|e6u#0#O3@jo!m#yX}%pJRYmC}NUa z;Ah?{hz*C|L41ECbT9{P==mu_@o>n8*A|m4+C#khPgNlgt?C0tbQu5Z2CLRTogha? z@;F^h!7H2dOqQs@p4ip*k)MW~Ex2pN@xd293}^s3`w+s=24mZF}; zji|zY)vL?B!Z=pD-6`lXL%pxq2tAh_?8yByEB7$2i8HlDW{}&PuU|it!Tj@{KOj&M z0i1qj;1(zPe=hWZ)(&sa{dfCHe=73Pj^nyFvhhB;KRs{cfhV|^f8{0Yhtfny*D17? zLS>=nA%BCiMdO{Y7v?pO#I#cW!&m=HFz5g5F`j$d8r>21FcJ;V(WCY4rt(TH$2y)W zM^(lG#64Rd=2{>>(Gza2Ij}q8PxwvUAz!ad{<`o-1CJe!w<|`QZ+tc`Dh_(|VsnWo z3A|M30GkfloSw-&eUQs&N^!}m>sa4Z;4(;c0eYuTS$jkX`cOgaF31Mn+wqCx1{3&? z1b*^Wdf2H6=JX>J;PEE}TFikLW<{jJ8~!*Ebkh2ato}L?I4<WC30%o)D~)+yi~n zcK#&_e0KcD1Hb1quw>+Lr-q;47W^B%j@g^KBpL-ByZ19*;^S zsO%o<)m;<_>Dcc`HQ-vqOVqvW@=?lg#qU2mVhX))!VkSnC0n!yJ_?ucuF`fQT-W~b zk@Gb6DIFm(@Rz`OV&}z{B!QPGw<+Y#V1LKk2VQxZ1Hb9lXwUg$ePc91m>$nn3JXY# ztpdJO^XmWk4&N_k_t$ENpS3&mTqhkkYtlU0`4ir+sD-&E{Tu3M2<2Q13%LIkb3Ua{ zu-h7)QbRMS9}}B49L4|cRGrxt@Qd@$3n^zgz)P_Y$I^(Se#0QwU|9xuJN0(Bggoqv z^Vei}U&47&fVf!zBH zvbgQ=PGc^vA=YS30&TR&Dp7~KD}H(&{cUg4%KV1om)YynjyRuGBIs!3Q`~P{RdR0| z>U2I|S6S_W9Z!6rYCerTmuS8a=PGa>`Kens{($FG5T)3^2>(r;bkq_3D1Ol|oCkkM zzViB^CgOJC$tiIcBj`ytv(U5@>Q@eVOWVS)%6)l2p#gaw5w6JdCfbP`F4(05Z(Y5z zney%{zSDEy)szI{1JA=}B4&ZF=-fx?%z=kgdq;W&Bf)Dbb18CpVZZvvi-Pi3fv4_& zx7vRh>nq5$jXxP-zk6mYJe%?7;`^8MhEO4@!;Y_Jml{m`H)yGb83 z+$zfm{MT!0RfNmqI6F9n1n-$P4(a|~^3?jF%N*d^uB9~@oq^G0j*F3gyRD&pg= zdcb++CSjKWhMd=#-sK&{ z^&~~|*RAm0Lj|I_wLb8}2k+VwS;K$tdu94n75bESNa~Upc%}D#jmprwUAM1OUZ+Q$ zL!+4}ITif0|P_d|A|j( zo;Iuz10k18C;8HTEF*3jVcPz) z1-)jGltH{h4Hs+Y;7+B&3RX zeMEkDP-JBL4eA#=YIYrLMqE4S_2OeK@^kvNGs}2B(f2tLW61X_o?Nygz!xbfTaZn| z_^*kDa{`y_vZGp~jlw$7-tZlw_!BQJu17qfZAN&_*T2h)$}+yIX^ zX_4ye2_E>u$_YQri_CVqodM+Mcj9}JYHj$N)=mFM=O8zN+vH}7z(>~Y$pH$`ufeMC z&y)}^MhiY4P{BOZ`^Zda!q4r`j;J$$9#g*%8Nzrfau9U+?RWTt2;pHj@W|3ULXH8z zPb#~vxNl|g*+jdac=-8^mU8t&d$DqvX6Y0I)J-;m^I%tQbIr3D$NUs@f>j- z8ge4=)VF%x9VNr>yT4`=!#-v2%`i@aeNukQc6bGLpJ?q_zUC(4amM>ok>8yN6VZ>Q z6HvD_zUyU#$PoAdhm|6aKD6_Kyip&Je>w7#DsB+_TN!l)xudme8u45KKVba+$lJRu z@MFP|HkrlX&(>C?n1Oo+9&cr;#-mnAY6KcjuPLbx46s)>&8B$8oG6 z>D4_5T-JSn(cKL^!GW2cTpKrh4^cy9>9ds+;pF6zm)?emTYCoH@Lxpz{A;i10N|{D z+oiWnu3>-DpZr#onEIndkG*o6ujCOhJKV;3y^5 zd?sGxJwr3YT-SlK*g9$Hoq@yXI3H$x8^=BY+VL{`@!prrEvZL4urI(c1*_-)@S*fo zPi9<4(K#@?j&Yvu6rJ~notJxhOz09f@Q0X&$6j98Eq2CcO&-`Q!|qBY%v&VcdM+2{ zE#%|x-KX(;ipae9L->V5*50ngvap|uLYHWCfO}YZ^nINX*WEE1?YIZ~Uc(m`m;pRu z#Pmd@5cYpkjY*>#^3a+{(Mp*&!yMv&kcWN<)bNk7}q~q-Z#43hWO(3Ag4CQ;jQ{Xo04?I*+=Y!cj}e) z=RK6zX92$E+N52R!cLyMB)}B!V~lVkG=1H z=Q4iVx5_R;Mj6?OWED}iviAxlG7^z3Gc!tvY@(Erk(IqeW+fR#nTax@N%B44|H1Qo zj^q0r$8#KyU+&}WeZTMVdR^Cfo!5C?_v==IeKmB3tjV}22yrt;%}aro(=4<%Nn_ou zELSBD+^6MZUh{`Wx z34}e_hmo3Sn!tah5)V9!#Q44QxM+}pc{v@i+c_EbaWx@Q4)NB#&B)~XHH^o}zAO#g zcehN&ES({Aq)e4^5`FLtW7%dx-@;r>Ja_t4!gDWzS56=vPQ}Z37TgCPz86k^6@1uW ze|kTm59_w-Tk^BrnD@0!>gT{UqA6B3ttYUPNv*0-#7nunJhO#R)D5pW+`M!h^Lr;! z`Ve@`9z(IIT6`utf2$gu0SaHlsTl~*>Fx7-GV&1Tm8ExJ@CJ|aUF2!{aUOcrT9RU% z4eqOem6ad%E}&XDt#bqUOQ8K#51eQCUSQRiJn)Geoulzj!AAv~BC5el$g@c72+#lW zMP(PxfQM*iu4E9_DdjBib7jNv$P(kJlC+>>`Ki!I$U;Bc6EJRl6g*@)#V%VAdG4y5 zzX$AL@elu?trT<@&tCUX@C&<#B{}sNxA40iqJ(~qLm3QSYVNSR!~$Bv{jmJ}CB%j6 zySHwY#BdY&?#|Pn{}S+fvq@ol*dINQ78gS?c!+q9lXwI4s)oZK+TmBd4D$sf6Tn?= z$qO>@Q#^C@wio;@=0e)P;BWXHoBaB@CFD;Dp^S;|ktZ?C2oE5xEMM0;ak?ITP*y1h zDrJZxX9v)LSG5#P!*Dg0yY)9(jsxF0PIJL~%zK))fk_pG4{^u+PH7wuOTlqpcBs4IBsczN3yQ^Z|j0bpItqX zVhsK)XFT6z0i3Wo)Rc&M*~ccdT<3&wdz4`-<%#FDh|`4k1wpr{7w&ondrbSOEmQ_x zrup|m!711`&A+QItSPuogZ|(8_$)b7IL?UeeCd;8f!MZ{A8~O;URwHuh{GB2ldbw_ zoX`V|e~U@U6O5CajWF#4#N%J`pXn`uN0qXNtDU?4kFWg?(Wd|MX?A{S(C_+$zPnLN zIhPg8&tx&P_$urpH2<{JXYio`uMvLu4|h2YU&{bZ}(%Z4fx40&t<;ju!~)G?3Lc|R|O{5Yy4jDpOq^W3`WS) zk2lPHlg57ehVr|Ffm2m^ag0Y$ukmNyD~au1RuMyOKIFe+@s-nT;CcL7hi&LlXMaS} z*Gdb2Eh>H%LWeqw-kiY;M)>;&=BCFC$RkWzWQHhF4^Z8!+P&$bkmVoiM~XP3MAbE` ziMmGra*%i!^8Un!&oXSWwT=_%RRiyk3MY}01wS!~bTXF0*2!-BhvR#^SEct}D^EYx zx9SQ~_OC;HA#bq#0G>tj&P9qO54^2o{>_O8SVxjejJDz->Wz|duQ>8ix2rDG&xM{4 z8}ZY<1N#p%ZpyC|pzn%8!?5>0>V=_nzpbHrJ!th5dycsD`<>2dAwN7n*v~lH-~$~( zk|==~@lQHKSA{wnJdR1)Ml}mMTEcA0v0Csq3d`vs@WNw(tODZDr94hCHuod0Iul2a zNt1y$3w!5z@1TD4@XuA@Z{UaFOx&j@P|uv_@6bYDjc?$;^|l&3_g`FnxCUF1D-*H; z`2WQuVIg0PhrVs{SjaEbVTC_@vLQ$Qb&k4;&?iSx#M+~d@jYqO%AJb;kFoW=C8t3= zyC%W@j0HHh!0IE7`Fyjz?a!fzzMCa?7aPp?TSXQ=wad^6jO#l^fQPRa!v=Nk!fw3x z=&%FF50>eKDHQ`xRev58hn@9rIWb-w0blui|GUgP#4jm1*`!xEZiuM1R4@9lbgKeX z`%!;hIZ>~SE&E=U-tQg2!5jnbU$9U51u~ar;E+^=!OI)fh$9^zi21>b`2K1=ryKyT zn_RE$dkeg_J+tp9w&9j5CC>Q&o!?YdcfBQ!gw@c|0`$TnEe=r{inYC zU+y>xbufUf=d}K)eO&DN79Zo~mp?2W#GY^eXmS-Qeck z8ACigXdPSe9CaUK@9S)p=oe$VE6Mb32aKY1dalq zU;X6I`3C=?%w3DJFohq5DbHS(MZ9pI$l3!xS-yGE=QZsAnfR`Ml%$9c93Eu#&^5>Q z=yrHJ=xk4goqnC?XKi-?3k9KJmexJZMN7Bw&|zG`7#r;`zpsqQYz7XS8}|b3_3+4_l#* zWFqpIrI*dV$OE1$9v{~nLtddX^MSBFi>XR`o(AHYDc^zuLHCZB(Q-*Bf&F-uo_-A+ z5w1I^%bAY8?gjsg`JuoE{?8NRh+m`j_s$fUp|03*IGf4<^(4FgElG2XtBP92aeP1d zVE@w<#5J|)<*3|5NiD~0F^b=X4A1zU5W6W4Du>)=f-_0V_`I|PP_Fckw&fQhWe{~DI zvBtJF4)@bI^pL0r^F;AW!S7)+@c%(esKiU;&8PNM{~W`8MQ_tFzr*w4OUj{JL(sdf zE>aeE;yS#a_l#m57>N`lF2LRui$jNUGr`Z~SH2ct{9Oyp&fS2W8^k#}HQ;=io7bBY zqR>w#y{00U_>AHOy zhX$zqpE*J=wQ|ama6sS6eDtMid*}yo0@~yjCby2XhS|UyZ(sMYz>VV^@E#gqa2xBwOvr=Q4xdXc(UZNHd3_~8(I@)G% z2m0!k1{Xsb#zp^*bQ1h{c_iz}7tEvXA6b5K*xNj@W0dA29G__X^i~e;D{Mqw0OO!v z-qo_4iacVj^Vc){{`d)tvbikSWno7kp}&t&DwQ6Q}~OYGf}fh4f6KbENet6*9FkuwZ-?R zLG(M`cM~J_wGDhkDw#L*8+4x%@nPjN;91U;{3Bob@V!;N?IY9=PuNsmBdk|6@>zdy z9DIk{Df3!3w#9$yD39X*d989{UeLXWGLvezI#5q3?#Q4+|H{1x1DBum(32D+tGmIw zB=)e(zeK##%>C%^1|FqPPvZ1C1o}Z<6&nqBS8kI0yF0fKpVrPheguyr_3PLt2Hi?b zY0iPr=bnFN<2nx=_`qfJ_f`U^CmE?8);w>(X|8IGkDfUZ|{Y8BUfAV1^CqTCR|qocJflc;;9R8gw-itBNX^8 zEFb!k3~{mK+WX_PPmytI1>fe_~yFJz3h5z(LKd17UA*9hRcGXT^}8)1?v(6W&j^ zt}hnA9*2B6@cE#7GV1i+$BvqTUpbCi?aW|1SuN|thy6bMyno-=57%GzHog+$`HHQ~ z&{!4m_gTTOxnme7d3X9M_(kS`#!w6~`le46#KWPZ^r z6z{jzwe!z9k3527Es91C&uNhFR|(@rKVZj2pAY*n|5J5*ZP*rh)aEdOXALy*rUr=P z`3m37YZ{tZ7tY8-o7E9IZ<4x-P6XB)`Eo01I2-z_SmC%P{DEXa+pKpIylwh?$9)z& zzgt!8+iDG-V^w%d4)^ty=9ZsVE8_cmQKqx)h<6+UoVUuLH@0cnGl3^X$3GLLLOf+k zRnN%6?}RH7-tITUdK&kh++wl>Pm_CVq~!ph?>^yqwe#OD z-k*YfoVi)ZnN|T^DUoq1;~8`Zr7Uu#a_H?o6xO4_tIg=GJ1ZHOmnKifo&;RyDwUMv zP4M1u=kBBs^wp@!*^vjrexsC~^09UB6DrpPo(-9He439!zHvp4gV4vk$GmUzJ>sg- zh(tk84dSxXXf4Sgj(fkAdtw@V@APK>oo~>A3Oh=JfWM9M{BeALVP}WBas*cqpYOM5 zFM`L%{dOf~tU{lmt9no;#({D4`=4na)WhHI*4V%}%sJ(4tLva{{?^VuRuQ;*<~&`o z9CWU?$KSs^1wAvgx-bMTlaq1($UH#n=z5{xA9!57?rVadI zTl&}37{>9tsX8#-RVV^>%Bsi>2u z>7_=@S4wm+We2`@H6p2OgN{nZJKtCje0M0~po8CbR!W+UU|hVC&mNb=ybzl<+LwYi z_B?;$b06dD7gw(?47(OFc)k|r4&FdnQtsu9{HL9EeAym#(#E;7Z*73{v77hpF2YX4 zb%<5)`E-|(D!m{&g9OE(MQ^OJi`>K3edjC%Y=7Bawp0^3tJCw2C zwifeo-IO%70z8+o_xZzO%*Vf&e*v&h0m)Pv)?C!D71RFqW1D8~(j=D;+$?;dHG%Q_ z-RdRaf#Y;hT|IddcvbzL`GV~v@>#DiwxQ+!<5&M9r0KtLlKEEZSOKhW_bS>|c@59u z5|=F|6kyAI?S(Ki{%=O^6n7T9tGzEo+W#lw*3YG?j9K8p`EuTmh)YW}mFhi+6Dm|j z`L_|j5`}qQHp9+rju-Tp!am|hpZHnApM3n}42yD556SfN9)>+WSKW4WzJa=trEI|m z_(KY3Q5-MqxuU04LKlATZ}#N(W#9p0mE6{XJp45v$3sQ`2h z_b;UaJm^=b85ykLhQALUQr5(_?86=HBb>l%5t*ZM;9)fl7u<68fp6?x^)93!@I$gQ zTSUOkd-eNkq3?umoKHGS1|A}4s^&=vT)VBJ=7jC5jPleMB)BfwSek6`3fW7l8p5cb zNd#QD=nkGT9P#^y^cdc&!_zpoYXtSb#`rgC(35gwJC|*SP@lWGVxSYq#)e$W#ruN$0R+y3Q!o)`ena${EMBdp);2_iEsiM;TA zj@_mr^yuG`jg&Ho>;KC02>dg@`rq#x;6uK2U&{6jx+u&Xkk9*3h`9MA;f_WEj_>;; zfBPo-=}khzXz^KF>Qs&_cvswI=|7j+(f53@?BU=$=o+<-Kep#kzs$)vIf?kqFQqQE zHiJI0#9j+6@Y0?H>L3Y>TNv%v>w$FWZ?9uw^b^MXWKC(WfKO)-+b-@?2EG{1IG)9I z4l1st`GF_cG>_ihG(ulajEfhYE9@Y`wPV+9;A+6(f8tr-*$cla=F{VNbxmR(~(!^CiKEF|U5)p?hxeX@PIW zNcM^`!9RN5C)>s1Ijbwb#Az{lt}TotS))!O=GTos&8B%N7D zKk<2XNh(RKN0GOGukWr+%vb#mHQ5+=aqQ8;vKr{Nw}|qe<36)n@=p!Mg6FA6GTplc zUUjiTMLik$Z~RnUD)_+Zhk`G-fz$ohqvd>ozc;BH?DTVy*SfJ@Cc*wwUL5v^5hsTu zH@&;8fWxO;m{?R$cSzpn63L7F#b7E(l^Av+VxgD_dnVsp5@7|eo^Q+2lTAV2p=jUx z`K#bZr$d9PRiNkQ6WbFVg06LJj_CCstgBnU@bLLw=v7&}NRF{%oe~=Foa@lFu6Ay| z(bfb1a$)vdbj5oa+5dP{#i33a@+$jwG5P@YnJTQ2AIxmCtJX{*pSUru?MjWfVqcnE zsR116Tdy~Xhd#uWcq6a_>#13^ZchxOpP8#@#o-0`V<}&_74U{=W3g@|8aN`p@%@D} z__+pGCY=R%P`$*PIuq!bUn4g@nj=3X8?1SI9(+5I>PwX!`0P-OgRvWMwE^h(8i8h4WHfIxIFE2QCCyZH>Wg&J+PViT*LmdT&4!G#=!aTpHFUK{Q6cE9-Oqn zb;W0X+T#K}Ei|Wr-W$KK`FS}e0OvjN<;^Ad-AJa-DF@s?WmoSpp%@(Rfu3F+#`TaM zT`U9a+1}vd-Od8=T;i|?v}G7irlUbr*eYC7Bjv<=*8h<_JB;zqqkZ#+ISu*~@y%K# zjH~23;wHj#eD6(JMoO>4PxF2`OS@yd*L6Z(UIsrB@(XIi^&K!bt}K9^UoePZyaGFz z?|#w7WeHv=Y0R<&BMf@b@fAQRCSqSDo?EIO%W4*Z@ozx>wfcNgwP2NEaSby03S4|PtOL?%X;_Z3FkHoDK((k`vC&>)q zH$EdjQe~j~3_sV`W4QPp^DnS+Xep-z-wQ-Pqk?}-)>=0VWW#>Uy($-gBXTqP{GyMb z|4s$T9fe&O@{>B8%LBeh2S4yi0amKL>&db?N$#T7C`;H=wYr7vi@ePE(#i7a@C@tn~~l$`O*tMQbM#o;|4wK&rCvT%4@{6YmZ;^gKtUC z40JNJfiIbqxf<5scV|{!`a<9OR5z1x2K`>A^k4LTg}!xD?2eTe_?8;0YL8J6){{7# z=^!78{+FeMi9p1~TwUwb6P0*R_uVf8tD{&CLbFf)*AD8Gzd5E8aNkb@73iG7S5x1u zmNcEjdNKy~GvUI(GX~*vQhRZ~w_aYCT0|Z4V39i+uBU2=%(o*0{bEWi$vx23Qn>F~ zNPB}1KBnsSLOm$EM3rL>@w1IwzH|2z^i|h;4W0+# z^W15Zjt97|>`Ho% zOpKQLbf|}Y7a!Hz2R*Lk>f$>-;QB<^qX*#Qhkn;tu3o~t@vLmoxRlwX6{9ncClOSQgmF>t%ci?B7)X)+&aCJ>YfGH>* zTc?TEPpODc)6)+mV9%W=$0g)*p^NprzQmG^_?s(8dkyhG+-dmI&rJNkt>E&_Qp9n( z-KJf==#x;olFqRNeWTc5&;tHcTKMd82G*f?(AQ?%jP)ElUn-V7Iqa$+cR$a*49{@| zH3-TWA9GdkzTiqa0KO(}U}q`^J#4PNU$qs_f$7WHlv=JMKaZ5wEFDEZqC(m1dLy1Y zT#|JQgJ0bZtRs7t2puj<>cmzY{EBuch6LC59`E}lhX2)hd7cRd&hyjgKX1VAa=RE+ z%c_y5NMtZq!cVQ=WW1BSi}6&Hpy>!eeRN2gnD9I)llJZ(gmv(^jfPt`4nlu$=Ir(O z4c*oE)z>`s>G#&@o%>*ZNHpVOBDp!%}J?ORtTWa#f zz>AejU(CRVH2QBWXLZ325;(3>bYr}iQt70cp_7>OA7X;NI8L71C6kFbZM{x@;STu8 zL(Yvd*x{L`D9ts*|Kqm8A62m>a(XpEf^F^>T z5*iqvfQIxp*sp7Z+H67}^>!;xy%g}a_`lUVv1Z`&Cth38ok!o(tzL3+_^bZ6^AshH z&~+#Ulbdi}nl1Y1Q{XELRkU9D;LX-%;omh}fddOQk1x4{KmIzw$L0h5=2gSu-(c`) z2CJFUSd7CP<^e|Buja{)3)GLHBTZUWUo1jCO{*d)iEUU>N#r8#_oD{A;UoBM_3qOj z`oVu9D=A&QVK1-wOQbiW(9io+t=SvLy%n1_OpNnnEf-5EyCI)@rL|0WuY<3?_-|VW zjEkORX|X-F>6uG@mw{W!q^hd8zEAdFFP;j)eChseS;KY7aFC6sqyQJBau{QAeZQXO zS}bHCFPi=Kv7{W9k5d)hh94uco&zYu309P6mT z^Ap2O>o*BH|9?PH{#XCxZAD+ub>Man*PG5H@T+g~w;r5?ZspP6ao`r}gI`5OPBnc; zpXru}xaT7LBh>px;so-aoPFh6;MsR+#`X~UeJ7GQL$fgt0cVF455TSq$9Vc=9>PB^ z`+RAJJy-tGKCD{;dqyXe73RN@XQg=u+v=l49Rip)%P%dm?^;49j^X-(ct+f?4D#DtD!v9 zxc@W4Ydhpv4?<`oTxd7&=|^E)DGBb!m-dmxU-U=aQ#2e#Jm?YsM5X)*^_ER?nql;R zoqFbTzy&&2!;yx3U+^rA)*Cdu(1~R7{LahOV7;q4#u@nn^x-dZRxzbQr#c*V>g zu|4tnQW*NhiseFH~gKp6Lh)KL)qP~s0$jkXS@qVy=jZTtQ~d6&y1Je=+vVA>2}oS*Q^wZ(Zlv{}cDEs^+MdFoAWK{@&Aeg6^fG(Z=xy^~YDV{s*;R-%x^JZ|20{oO^<56wu64tTzWIWr4@h|&Me~<87<465lBmuI> zGXr*MPk}%3ev`1~kV2pEKyQ)01b9V;x%NfOuby5!=~Ff6RA17YbWOpJqW=_10q0pN zTwcj~1FzquY4HRhPA|G=5{JTW2ma710oO?F(^>VgEi$?N5*^_RyDX|kUfw|eG=G#M zA#V@;dikp)@Oy}xBg4H8bp-7O{`g_UQNv;5D+`DpmnoEM*N`s=4aKJYguX$#a*%Nw z@og=T=`i@0-s_G>6W~!{x65*iQD3Aq5PGPM=elw;toyIy|Gk!_ILn7s5!0$G*mp;fFl8ruVMPXhSl@6IlKE(PYbm>Lg*U?|d7EQ^ci|1S49Y4%; z1oorxb|jSzynie7sSzihb8Y^*Lo4Z`z0T7nZR+H)P?5q;+9s>Z-^aM4S^MF+WeQ@dQNG zKzDg8)_brQb*T9OEy6mZv!P@ySr~`KN8OBs`BwRQjq|$-@T8_ieHyqRyh>K^mlyhX z{#Ru_+-JE=_yte+{k7)_gQUQlvoU`xJAo6XcTEB_fDes8-b#TFywDI@ ztipKb$MWUuDuP}ikS;$%v+ajeQj3y*Q`0=Oy$wMxDU-z|oCE{>*3fr)S8+#QOpC;GMM;_VI{~nl8omN+PxP_>X8QN(3i_%YL%69;`$l8t};RBy=JyP`v<29yuvZUoW`0D2v&2{)?qZ@EZY-E#DZ-Po_0(X$T?TiwX@yTp~a8 z`@yCc_?7lq*{km0J1<)l9$X{nt$(=LG0yJ~PpoeM2dtMnMBgW1Kaqh$gy$?WBTFC9 z7s6f&ru?pz!4LIv?@d->Txo8PG*p5AZLvqz-zf1Cw}OYyBfnL2c9KmwAX(X{BQm0SFJDbQzO?slGX5M{q-!3UpP+i9M7kMR>a?~ zlOOKFzVtnx$(4>nZ?y3xu9$=lPxJe<`vmeN`-;)Q5%^2H{+I>!Be^XwdY}{I>~2k) zPzyi#dWWnB$9uAr+afkg4{Hc+LqZ|0v z<-0}AzK!uu959Rpev#ZO%8AChApfh$(tmLA%=LMizPN8+_iP1HhDpNx;|~?C{IWeBLqGDZ5C>!XWaYiNvh@F64isZAnE<;2|#ODaEQ$zg{~i z#EAJQG*@|eAM=oO`Hw_vXoS6`c3Q z;b+Hh0!Ku+Rx^@0(RcA-Tr!3Y@zpNWDVY)V8d2i|Uucnsm~Xc|B}aW!d;Ng|G5mSH zA)5aW^d^3y5E8_PZHp>1Lf!Ghp|p^G#3{4AWqhR{!7FB`J&uo}?~3Zwb&6i(`+a)U z!*$>(;_YUwh3LySe)iK7x>DHrLqF?LPdrEZsz@F@XXAXLI6L&M#GhkMUr^@@Zkm32 zGzal6Bb0=%1J8-ISx-jcd^yvb+_$N~FNDvn9B0A!^>waYq#@Kt{~Y`H1%2;F+jRrM z^Q4OVOPavzb{p>O>GK62(sI?$yMps3?f2Px4eKq*4L$J;M?agT9Lc3z)ESTbKF86F zcv{rD5sP@pO7g|$AoQ%pgEJ>MtD*NLT5~c%=ivXX5LAWzWZ8GW)*nP1?v1-uJ%%{D zXFypL@w5Bn$=jviU3t5$UL6Jx>+x9kKG2BslsAZ6C_|kxZ2r9-_$SM`NGq`+@IQMc zV=3r{3OScz4q=={8jSk2NHPEAN-tRO`5;w>QYabvx8{Bbr-4UOY>TYk=LT*#JBSnX zJh2^$nJw6v-~-uTwde8tH;G`>WyIeyUdxOmXXLM$U&G^F5r1883QYlDFYV?`KMGt` zb4+;22OeVmT{t&13i`}2?2wyt^3)gLSG$M~<#*ur+%rjv zpSaFF2W2-_!RvB0f5m)6{!u$b!~?&4LUF8JA9y~m%P(~;9z5_((yH7I=qaadzgGnS zm+4}v*bq0k@KCnv*u~u_) zTf%x=@1k^0VO@yf0~r+pSU2^+=$RaBz0Z8pUzS0iyh^q1D>K*)`A~XBAl4a~sXxXF zyY*9T>5HkyI&OcD{C(Ds`gQS+s5SBu^Xf02R~FD$7V}{J8|F8KyJJ_zG2lzH%liNq z#O25QEIto`1F36d1`Qam4T?eIV&vIT%5J=2=&$--yxY(i{PUrDi=8O&CwP`yc|Z7P z)o;TL8q`q|EWF0|!Y*oP-7DcAjFwwv&$#d$&8KNoYw!!t8J+nsN$5<|c`2{YLLX68 zm@u_NzV*tx@eFXRrM>0PFPwj3yLckK8G7IHxW*~)t1(HT5!v_PHP4#w)Q%u-w~R5T zV%~OJxY#{^3jDiWolTVi{lxe}{=S>gLGJ$I-GrU(80UpN#PQqRC>|X&0?r5&%~Pm? z_iiefzQ(+`cNr7!!!|2tJE&F({SS;<^5ozr$M_Q~gKeOz{4rwhcLN`ne8g<*3BU09 zaP-w>=>9*>)Nz>NJh_f4eJaq^%w|u=9mjqAGV@^&MjqXJvNZsPfKX7RLX9` z^8ju`Ow{1Bu6I&v=n&UQ=$5CM!9$go%QJBv?@FVbR-CuOoVZX2ez};J|4dCDabG6ks>gN}4f_KQ0ZYAGH15XO5{xFe? zevc^1W5WfodrRZ%_rMp<9tfzThM$CguF7rAf&Yvjx>b;fcvT|BYlivzZFh)C2)wFO z>Q43*jFZj-=v2~bmE1V*-?y)CbKHkcc^%z! zh<}Er2^zQSP_J+Auldvlol2JF!*VxtVb$q9f3c+w4eZ#{g8cTAbgX{~@_so{)rMru z^Pe~8tZtz1lUn~ln+NQYI-Q>m^Vg=LYb)V}_&I-7q6OcZ>;Jv~3fE2I!TePg_ov9M zU6|2;e86x{DW)IS*DSdnFb+H*Svl)F4O|g@_BC-9aWF%AfD*W&Z(-vqK8m{NMj+2d zAM}f~?2IhftK*6L(>1`a7O#%r(sJO47(0z|C3yKl!{;g-zwgtmem<`Mv(*gkI_!8r zwmHgS5pgo@f!6K6;OVZpAs3+6G?s|UM?=5)4=Bq2>YvPeohJ#yx+hW;BF&fao~c)i ze7Bsp!CS=6k%xVSou77AUU&yyE^|`xF6QZNq(CYVHfmf-Ic+bLcxH=j^gXt3!6MMH zUzUc)N#eR%3qQHb!B77LdRPIkzBcEDRqLYe`I3hIiz)0#eU!}~TlpbMAp;!(zgzBl zf%D%Tb#v~NL0lR#{39Ta{!Hy32P*{O|9|q1mUAHQDVvGj#fZsTZohTZ-J_{iaw`lrua6v_r{Qbr#E=lZR}J|}{YtnKq`hK^M?*Jx#jI3?}a zeeeM4hYG(a=BJ=9NiJQbmxPXFcl+_+<5?HHCoR_E&=z>!4CACM^rDeQ-OUL6|7^%} z#^?_8(HGZhu7WqEQ2mnW24DMXJ=kdr{+9AHjgsgF`pC}Oy=g@~Xpr6ZfK9%Og4K89 zny_x@Z_TyEW8jCA757UHKtD_7*(VfP2YqAhuiMpP)CtS#gMus3hx2rby$-s^oRKFN z^BWh1BYf>Q3s6sF&B^+?0$xcqU|>yFi+Yg=-<$khHBG2Vo}vc9sT-@w-%axK=B<9Ox24pzOx@l=lxZT4gQbn?dJ(hwIOYXnU_ z+D4uBo;jBuBjVTRal*8y2Z&#Bo?X-R$QwsBCFTdg@Asaw`VJg2 z2|GnC^BQsbo>D|W2k`IUw{C6V*qp|kmsK(Ny*%0LAmIOrmHXWvDxe!ojW_Ot-y|RJ zQok?&`$!$<_QY}44Yx0t0yob~K5`%*hThOF&~J%2-8I5HnT6l&RlOx7nhjl8gvW~% z*X6uYt4ydTaUTEEz>Rod!T&cU#Rq!Ev}IxWRm9y}H>;K|!tOMe&K2Um2kCh>zMerJ zoZxbCpggWK%JYQ-{KauVb}EMl`Gbkh=`Qe(q7TAkRIr;nk!A9|h_mi&G?v-m({KJ5 zo-PJI+B|ASzUqT{lvGkbrjI%`jfo)F3FxrjZQDJ?T@>i=mK_&U#(S?Lj}*pS1mBkR z@&6W%=S^N#Z*S*8x3sr(vugnFDvOoRgk32`KaA5EKp*4txVZ0MA|iH0+D{cqb!bWPtIA(`$D=1D<)&u-Q#mAM4W8ZkPWC zPTZ%i>VE~ltn^E;C-~!PR=M13TJ-f?uQ!Q4hG@HOn1@E1BAFM^5B{9{ zegWIpHX=*9O&C{}g8la~@9*bR@;;>s9XS7XJZcvsbpN>@ zpVdi$*TmuG)zG)Kf4%lhhJU|0Fc2{fKg|?tby>>}>aja^f@FL7P9{z=uopbfQGS zyZx&j!jmvx8p<3#aqrOICrostbq4(o3XzPi;A2VTzT;Z($G_?k_tt2j(;0B^d_ul@ zoJP%oln=b;?we3q;Py8b0hiY&V4sigPsOT1XDLX2?rBD--`1T_bb_Araw1394|#K2 zWMyas>JH9|?VJhl-|^IEgBj?j^gHDgmJ8f|;GJD_AM<-b>*vxv@Ka{`iJeI3O_tWR zGw_SX&$PUeE~t-aw^UrgaWA;jC0w|IxOLkk_6PiBgK8mG#~c2&Kkn`BP|OD#i~qm7 z;P-US?-L*6I08I-t81ZKQ7REV?u1`b)%mHze+x`zm0RKe4S$#F54-|TmO3Zbi|^(9 zf1D?*A7(vWz{3hVZQ;+k`92zP@IwU8Vc4sf<}XG&T$eP9N-1G|!QS!>#YtT6efu)u z)@0y|{3m)7*x9>OvgkqB*`L}MqPuYX0-}ky(vLW9kLlxcpOFud82g4VLT?>=s?0fu z@znKcN_`J|6#Qo{@DlT#EGF;zb!)qNLHOtUrgB#r=x8QfrM&DXPuW?J_y|9CRqyN=p=|8x5?>yGa zSv%kryK?Ew|9~&7zuLF5iawRlg(Jr??#q;BOSPlm6>2Y{lKQ~M56=hfX-EGHPb%`s3 z*+YN+9BMOf4L-k|#wv9Vag5i?Ohym+!H{IaJvHzmnRNYBdEoyLag>=X@S^qO7UBI~ z#wx5AnSqNdf2sJS#c;e=L=y5M&@)~O4-(#6rOwDZ%ZLBJ|9!IK%?b3GF=r=_DL@Yh z(G30tyxuvgQ~D3MB-_o!{@nt3p~T%@VJqOVA{Wy#{F}Bq=LU@d^xJ`d9@W_2w8QTLakEF-=Q19uLq)imS^Dj+wmK6A` zL-EGEffMhM&Q0_l+6VsA{6lFnECK6OOg0b8gC~uBl9iUY4j%U@ zNP-q|?fNmSdXWMiBP(C`s}yz2=X5l&sPFMx$dld$KAKHjp6+;!e)sut5;E|wJ)PWA zd$8Y%$2&=}H1ze$R|R{-qYtf^qB%Gb&ujKp8dajc_}o{0{b2^`h!rA-^}(-REPnj6 zhT~3YGHBL=_Z)cT^->+%knetBp1|p_D|y{l%faKa?{57n!h0eQ245!B9hF&MTv!5b z+ZwGM`8|g91<10VbP?igiWhw)?zipTjGqtmy~Bm-Y~naf7}$HhyTzfDAgVG8O$02lUH4#_o5Ls0Z3}8mFm3m(@J!Hw=4OZXN1T zw*x=Am$1jc3;bp!JfSWG^Qp$GbO!jz+GMGp1bkoG)IF({kNwF%t*8PYAMFY;Gyy)6 z^9IGPzK6Z2{m4Esj=ClV_krLZ6`LekO z-+$`=Rb_*Czf7v+7WoK$Ku6Na#qT3tsOKG`OhF#>k^0|S4ERPc<^0qPU#AY@IXCfcL1(O27yih2ItF_2TIQK<@bC-l%nj|(*G$blD`;U) z-?o)cy@r2y?aykO!)MzM#@Ezg*KYO_RL`NKu1^X%G9lh8x7EwCDk9Eq$3Bcle9eCv zbvGyidQZehro3SA+#Yl7Sj_V*<+({gRm9Vo6`CCQGuOSTeIej&C2s$gK2bqO>t_wR z%m5u@hU!)?z8AckZczpP)9{Ul&P@yRcIc$yIL4`0v6d^^1a-Bp%> zk%%LXByKpa;%OB^e;joX-jIC@IPya7#L0Bv6!X`jiw_a+Zfj_QUY@ z|BmOBEw9{|1|RBArJQ~`4}Yi$96p2mudgb2q@M}=V3Bq;@fhO8-wuV&)6lz0-J~Ss zz~`if%?j}U>Q;fRXSiRZ89fy?%yUK7KxxNe@WNQ%ndKwE)%nZM_u>Ct_r*mPab7X8 zR2mmz^mQ;>>{?lZp80OR>Ja>o`$n6F1a$E~*M6=EVV*9%7OZ;f*;pvhDZ1V7YejXT*&de3Eh%Xl@as_Uh*H-nuQpdA8}aG9kcFoQ;(&B}e4Quab9|~CgAZ^bk>P3Qb;Plr`c$DC zh|4e7jpS~FKazcH-^d`~&M*Dp64>e12~Kmw>1Fd^hdRV%`%a%Tlmn<6mU(eW4#J*a zn*HPGgC9SNeE%GA{jM#Ak?u3(Sz4PmlLd&EX0&;P_fvGN&FzjuJbpD_ap^R+@eeMf zdu3vNm-mT0e*nH&yq3fD1ofY&?Ci=a@OJstRKj~Y-gFdLE%XCN_FfTke2?)t7diQ3 z0oPIY;F#eGc-#RevZk-l=czrP5P05ziPSNA;9K=S{>K&g-RZu1#u;2cEA`L)Ryb~1 zz1%6Wr`W%aoabF7a8^-d@DRSwq2h7*3Oo$j5c&Q6E%SA-2pETe&y0Y{QsZteRqDT;IIL`C#r#A?KAkm@eIMX35?H+W3QUufENhW znX>9`6bp95cZ@e{VdpN`v1?eS0(X3G);OXH-4*3sGt8};*o*gyf*LAg5!rD z4(uwCLZ6HH3Byy!A03;Y6wcwgRtF-So@T<5@d*mfP$HadR7>CZFV?TaS<1T^!5ZPKmUus_#Hxo@oebO*r zZ1Dl~q}I5555e!kjl~qHN}wwpu}g1nKwp~74Yq%;fNwAO{JO?aFS=uS@;LZRFry5u zHu#kuk@PQl{4V))8_@*LH+CXi?lo|di@J?U9`~E^Va~Mzypq|ZQNs(o?=?jgn;(qI zi$lEYH|ID3yjKu+uG*Cad!2UBJ@E*Bs`bHS3;tNFWu>*d0{8W>HE|KVi$t{T*25y` z0!7F8qJigODFMDlxDVk~yA~nDh4P)ErTl)iq-fb_JgD^fWW#zOTI3 zKQ$AHc-|dSPFUBV>xVpd2L2zI`+LS0e#8~hD(avC{LJHH(iTMAy)vCRkGL0kol1rq ze0(F-Ydiw;$mZvq-XvZC4#QjBzw;3Y%cgcCF>qV_`^x|D+>G4(Z|RitIvY(TNq@DmtYr< z#$~#HPlI*#5y*VQKCM>$W!|2-Uf^l@};dfN${@1Pij1e zSfHyEzp}MDPN?I(6<`3~MbIu@?UF-$Db}LR7KNR^w9cM5jN@*dFr+?)e3Buq;~u_G zr{ZcH&*=!zdfKg+i<21xb}kK6=D7^_YWsf0cWJfFP_PSA8Q<#&XB|J zbeBF95}v!+I>X3p34hL?`TKZ%0XU&?;ClEn@=}96#`UXs4##Osv zuOp6K5IC#ufw(rYr@nA78UDa(G?R(#NX+7%*YW5}NL^8$y#;?slcr_Cb}yMn!e?yF zG#htwVk`ao!$-n@Hgyvi#Qj^ z&ge1@J>?)zb}0Bx`7r0;kFVf6XY{w+H_-Q}O{-GA4qSZFPLsHZz64om8lefq;qHg@ zRygk87w_?=Ta5GBw@Eg@A3^Hgx5TB$6RDToVLh@LEP&a-eZ0|bPi*er2 zC>R`q{YbDqnE+4CWNp^IiW?!0`MUo+INnnW%C{UaOODLwMe$kkN;o#SZnPIsGAP z=v!As10Q|U#rPd%=Xj_EeKl>?UtAk`#O+-VR&adReePFzu^lYv&bPw%y#>UF4`Q36 z#8eTkj_0Gu;*zz2d!}?%VT~g2o5hS9G5dh)>gA&qe-H;2=DzX)2Roie1#!N|bM-21 zHC5mPuU@Qq@B&wOFV3V_fS(*Uu$KG=zVtI;!A%={sP5q`^C0+C@Tr@fKcMd%a}*6{ z!RLm)XP1xPLfwXc+IR(gWccxkn#TpGvjsS|FO{S2Gxbcq1;^uws&94$PkDZIeSB9M z`YptFcQPiRUZj`*S2qRy?36vcG>BuvnLOll_wKavk~7Cb1Uje zU0!L)(4|PCLcHyOmrK!qM8~0v{rJd4HH_;$No_btiSu#_O4xJYz7E{nO@0V?*ij&} zledm~gWt50+Y)rOd!e(+c%H4FG4+-=^e5@aPM13Tj$3bk{9qaMHzDoICcxdvLCRg@ z7?62xizMSDE!a=KwyRYg*S9X>Uw;lb zUsyPBSOvWH-gD=T2;lAcN%cGSbihNwT{}DM;0qnqpB@}VT;y``t%XSSGzsIt8`D$Pr?p!UhLcH^Man6IT>2& zi}N46r$Kl>_12po(;SGisef~&N5T*X7<1qM!1?vw-jsAm#WwA4viU>gMS`8{VkN)_ zq0rABz-g0bd*7)%1AjYTlQ8xacvfe_9GVCF9TLl0Nklw+7#JXeK3SC_H z!X61hJMb(#Uh_1A5%_;0V&g34HBx9IUlI0o;LH4JMI-Qk^4}|#BG9+?4JpL%A%9>? zD19uA_fnl@@v}8Uy*SY-!ND7P#vw;;MdT9|1Iz0{cfhZI1R7n90dMelZc!JC=N|({ zVl9wg9CmcIAqs{bcHp~5PZHwl>sKO@up>@eQR|=Ia9-u_=U#C@=P4S_BauTMwo1j( zr;2!RB{uc5Jn(>SuB#CEF`mSc7RHL_8uU)cUfqRyS8;rq(hl^`*$2-0d%(NMdwc1Q zAr2|IzV9@H{>iMf%H|E6@C(2H0ORIy^gG8c;D=LubWTk8gp|?o(E{SB1Br7X>l$nT(6xrkZe0~3i&rj!Zzs9-GeVyxiUeD`! z&VAp&TlMz$pU6%EM@OFgWJO%L$o^_=fnJt;b)R<)_|R_Ri6=pb({dmA4}|w`8YKk0 zvca)rM}OS?Ce%weUePxrZlkiA%4Wf{_$ANL5_HOrdsN2zz`rIww!Gg&-Fa9;X675} zI`Yc>MwY-!Z@#d-B+%!Aqrd;IAGgPPKX)}hKF{fuqVw#+`6Vw7NFe?bj&S@w+Kf7s zufD+=$Dv0_YMT0S|AkcW`YrG=9oOO7ddzP=9~1K~{J`nqP~t9d|3zc)^>)~QC@MPb zZZPIY@lA6Z;^D0PciX&7)YtX*$|w=nospj`QV~}~svpV15Qj;<4%^i!;7gL5T7>7Z z#teCFGJ}tWMaWBjLi|^id+HUVHB2N){fE!5eA2mjFc~^<^~lcN9Psclu?+IJ;NjO7 z`h5zatKI#NyrLAk=89vIXf=3C%97=`kI>C*Du_3ckA<%qy?<2?{xem0hVb0xPKKYy z7<&-6dFQ z<%im86Yzz{q2pi`{PA+c@7@yR@y<{8pOr(eX=N-Gz<5Oh!UF2>JAb3;a?&>74qL^w z+)n7q@5+QOqaU08);zf}=smGVy7YyYAKFn*g03Jopbv*(uGvm!nreuhs{+k+R4yKvFIf!%rSN|XpZ^X|Quev05t zbGKDn$6&S~s#`AEC(L zOBt|V#4**Ji@@82Qs#-$cks6_N`EHdAFsQ4#qPkrY{zBD7viA%iE*AA1)l#-c}jF7 z0(EeKuPMTNn8*$WqUB**XYT)yKgLuwfN4=3o zyrXm*>mnW$3vDj&Gyb2SEj_{WVy7ZtT&+kzs@QIWjmD2)wJ=rOS##o-}T$eXWi2 zFpuygY+GX=`kKzND6XqUI=E_rpP-9qy(a9-y)7^$-bw~O*C5=@@eljVzs_l`058(* z&-qMrA}_@W26BD^9;rIbe|tyZ8&A1DL*H@ky2S1Lgz%g#-rqO;p#LyB300u2>aJxk z3I^X0BPoB4Jo8McTShV+ZU0Lh0`J)u-805qgztsbUo3&Yq)2>dpvc61^N*;N1Cyas zDOH$Ef)`aq_3)8_SM4*>>XU(3z|_jH{&bqAmyjo#H2DJDn!G)@hj z!u4MrbFM!@_}qu~lR0qNe}}Y(?JM}-zAH3Dz`;GFr0dRu;9WP#6vdDynEy^6>;j&e z48JE!9ReQ=b7^D+UbA($r}|?Y;$$Q)O=uHtGRQy1=Ux(#QjbQ#1Jzki%_8qacua~V zuR{08tk_N4v6oh&qJJB?2lWbtL>x5}_8W3^(0IYWOnd3fJgxx0hHn=cn1e@;(53CU zi~ES|+*IoxVjVkYby+7Id_V5djqVqShgavqd4R7{{5<1_GO%u)yncc+5%KtL(U%u~ zzgm;prwD(`zW4950Q@7Cp-H#h0s1}lpN0hZn`Yh47~wh7dx@kb&%=-A74w8lkheSV zKDl{6?p_8S_^Tes znMHh-tWiBUUId=FCuF5L7kogb*&rM7slMo_IQ%e<0=6gpR(QklxPhk(@U7|XLL?Iq{I^??Z3FEvpCz;)+0o>Iz zmeM>99j+H!9$Pc4CRpE1&Ukn20^WN)^ysXKb2SUK7inKrX(>uVgY8&qDm}CC3S)Syf zeaUmZ>7g5Rj-l!G2>9`XIy>ti_)U4vwBaL4;6>S^*^8XG-gt-4EEg~zfrWXYz>UE} z!8Gj{uex{V{s#ELpOV6ZyWnM1W04MOv-Z;YXAI?@ZJ?fEOO@|nA?#xaaIU-z+&wR5 z$AI}-dwYlWk_Yr|PU+Zc;6lruYP$@1@Rqf6%+qX`$E#UJQaJx(5jT}JBH-}2*Qy1M z-R=C$jE;dX=e_pX5(ckdaFcxl`*H1ASNLNB{`G;r>-#n6Z3fJnje5`*BdNK1(VjZJ zRdx}dmz9^%5M71e>=Pg=lZB4?BZ`Rs=5iwLA{rY0_5UE$Py7OT zd$E6f z7lm&v3}uk-#$(>9fzQz#3;bY>aqrJqH{1g}+aC8?5k=ipRG#1U19AJnIMa3nyymoi z;Y1R6l&#_Mx4fvcvY4K%J_gUqlD=a~h3~JOPHxu+zxw5*V4hSA-jrH;vKIKH`9fh~ z3V3pI_Kp2E>ZO@0VJVM+i@D0S?(~Rf*X)XyY*Y5q^`ce=JQG-d96GzQcL2}J;T5=E z3_bk;Rf_Ii;FR$ii?=xNuX4wghY>io|6Q<}Ie6U84Wb{*-N0GWB9qJi@c$)Ky&KH9 zF8UJoTbB@*PQR>}ZlGS-*Qzo22+sp*&o|Xfg8s{1QlDDv=#St-v1>Za^y>dq_~Z(B6VXIt*61eUSw#K}9o}p4ux2^j56^AbYZg!c5AV60 zzVdl$0sFLi?6OA6*0D~wraVSDL(o-w%kP38Jqlgl(8Kr`P7z)2$9ReL9~US$Am0^f zTlC`d=?`z0YrcS&<(O$5=tNuwYd^8Y_!Be)OCoylJMqP9x4*(qbG{V)#rWejUrRe; z{QqP5iYRiQf1mCk@_ywTw-Ag^@y(GY!n)teW9M#S@I*%umpw|DU;a*sgKJgbr9Jfb ztr}s!m+kQ(t@!>+QYmVV|&W;{J*v1?>qTo0|tJQ7_MK zl5W92*7#C|2C7W}t_?)~X$y&q<{=Q3Ym2?krVye?{9(mP(R*j~^8F;3ibl(HVRC8U!>-SOL zC@zyo5Wk!Im-d^;0QVsTUyQjT0(%^g zc`11Uc-(PjsC5ya2!X+J`1>Cs*$ei~9ct+HCtalaknrnNqBHq8peLquM zD*AC)KasffMhLo%@+G1s>RK!5#eETO+;wNzL zRQLgrlx^_9)`%|~2NCz^fJ#drXT; zlL_}d9e8?rzY+e=N-^IRfmSH8jb(cc``1De_{*npy#l5Z2Y|cvx5`I~!RM;%_nQ2N z>rly7iDblh(q|@jW^H`j-m)>h!I7jGjTAX4b=m6G> zn?Bo*A)nl}ku;Z72k(Dcs!eeV`6XK9O$6p$AtlT4c1ZvCJo*Xv$k*<7PyNs~bRPD{{J&*-!Q|>l*oVD(^MWn>V51>4!Wwn+)`Ddd zj#cv(*+`t>*JZWaMDV{5P2LF+^drQ`FMq!j%US05$3uU2NQ^ke=j z=&q@W4=<&F*FC+g5&ax_SM!)@BCg|weCYbXQ`B2wy)6$Bw=ILJI)pl$zS&mk1jeNz z%rxHNhWKpQ>+1(T5KmX7Ux)alen4ABcrGq&_G(=;c*>TEkf$W_oJn)XcV}Plo!Fg+ zhKA55j0JuJR+nz);H>ZC3D-$1g+(&v83V`5rH}M_x7kVp$2inU`0OIR(6$Ba0T1 zfgQ-=PN%fNpLd^ZdgU)7zi$q=m|#313;%-t?1SBnzV}|nI5a-{(VdmXdg3M0XPw|X z@4K5deU+h8>DhlcehKyB$-nI`qR`vsPriH#I}Z%|`e)-j*I46P7%sp+c2rBx(}5R% zEOjE>Pi&NU*!0C9^sCNY!+79HaV|$z#(wa0zJ+Uw_yjQ*#Mli(R9kD6Z#<9chW)r|`21nF+JoZ6ncz89vGD=+;8%u%i_4_I3F6~=yH9{0&NMNn@ z+uAL-&YU(*`W3{nP3HV`5#oDr_hY0huG^En*f|^LAI?)r@U4JOHPxA-T?*XGlIyUo z$3Cxn-oLCypvxcmyJfYB{jZESoDG?w|8WN%o&!GfM$K4r8KT}QJVIrPcIy<>{D zU$T4jH-5LLviKGIH|Wg%joe!@0Cm2S0zj?xK%HRhl2+yZu=Vak3ycT;)d^0`LbXBYKWjP}2E@PWi%!duh8 z3k8ON=R?3jG5a?j;7grT)8Y4Veg}orD)xTV6|XLdbPs@+OHll@LhEuP=Uxsze{#}q zR|Ch+w-W06z_0Rq&C(5qVGpzOFSOA9ulZG>f>YiH*z0V5JM#tD+g{0%_9pQ2l4aPu zJ9uuz*Z(>k-hnT8+I{?33S7SUiy;-f$D!m_I%6w%ud;WMFL;%)G}~RBFVJIxT?P|y z-7HNV;X$zb+KJbn3SbwRH;Qd-m@l+7lZqdK^b)FiOCBjIPbLc zsasx6ST7vf`5uFQb4S>1sW7g}y~2g^)v)s+8kOJz*w6EQoO&Aal-hfp^; zon8_qyvOAea}4j482;a9llw~)Jb7Tn?*ec~_P?MoE*0eI;E`hwufne_Qih9h9;(*l zaaM2e9m7EdLGUTs1AqT&J;rrXZEV_xz;B&%NhVOgw;e1~;r0RVCwcryANk|)unh6G z6Y^HDn*am)i45Vqr)vxTC&_dF2tHT%*4az{0CqmK@l*nNiQ%;h%L=a7QKIIZEBK}L z4jcFBSn#g!{(&qH#NR2}6GOP(7;pb^NeSe;`Zf(dHt1XJzR!Q{#W*uuMJ>Uza&%nf z%b>SZT2OE9nLs@q{dY_sxD+oX|I7^dqbxCQ?-YUhzCLuV))V`FLnIe#?-2H})ZVyo z56_377l zqzOKYb?zHO&j`=Ws7QOh8*>DHElRPUi3RI1ih9b-`1}e_vfr~~$X_w8)`aJN8GfL5 z7eU=ARcqz{1bD6T2n44m@fD z(644*)b9aKue6_E8^`tZXKU;{M?PuFX-;W@|0r7B=WVot|E`*@P`iVteB{XHhJWx+ z=!dI?Bfs$0E0;Y5ug{9QFbh9&4ArT+0>93yi3q5_kLz9WxIqR!#(llCd&~iTLB}d) z4!_ygMmkDw3BR~~hfc`?arN8cv=Tlyl(Ckl0H0T$+`}>+jPn+hPCo#i>zcSK#+N`> z6<4Z|0-m=W^l+|1d=3Si`R&w)cu1D!)&wp@E48I7v?5L}{qX6z5((1;1%C| zT?6vxbBOrEo3}&1;A0i)#VvN459mKtC{-!>HR6E5K7#PPff~0P(WSVq zJGZZy&%?jN%8R=bT%n&RH`1-ZE~6F_Qm^%(Z)s-?Uq+rU+MBjg$Bn#Eyruet9=vio zu&)q#>;8`&k?OBlpAM0cWO)ysecE>_`6=>f)0Kh=)CG4mtNKPC;Q4Evs}IjcLdTr* zye|XY)gpHIFiQ^dYUKTLiI@028@+VfBdqs@larhUk4o*HvZYtWy3op!wx$yH_h`=S zG8#b#k&|P0@CHAkm#BT33%*rzF^dFzsrp5iXc#qg>)9;2;WOC(ul)GsUW~WVfj4SjJ>tDB7vRkn}8F?WjAMLhw)rI@tzyoTlWBr#A2RgDjtB0UZ z|J(DJuy4V$RaXBP>`>Fo?j#LAr@2$!`wIR``QOyh=di=V#goqCh%4#~H|xKG-)HT5 ze2YQ7@SifH#vBuLh>N6>E*DS-vhlsY3VahiWYG}_TzkAtn)8w!e9HLYn-cu)B5(Q& zFO2sNeF;qr{8gFL>%%NFbj`fc776rs|RV!<(9OCfMfdY$KUW}VAyF32`)_c8|MGqj}$|Qp&_u_ZAzFxX^68QV# z0nb53bL78AAKa(Spx4@#2G?CioTf}y-o^iJijm#k25)RCuRURa`KAmb^LPIO`!9ZL z{f$=9(P^g^aoWD!@l*xzcdSF><^De4ny1c08+5JY+uKxsP{;Y7AdQ;`4?0V8QpX#u zPu%jL!;$!XN}5RP z7sRP;*nbfOohO;1{=YEfY0C?b61R!H+qtj?#iH zsWwj-9Hn1wZWq@>&!VpWrQ)*!e5A0-1=72TMp!|!`SFJb<)DV=m`@VyM5PUctOF~=NB zsW$jqgdsnvS3dNm{EQ9SVyq{4ci#R6oHm>?X}yJct@iVl)&=g{IO`NV#yo0!^Y{O# z#k?OE|F0E(Hgw!lJR%kK{-E_DX$0!7-!Z>DJy9o3la$U{W4}YW+uj-@@VC)`Hpn~!w}%?%fib)kZ&X%`Rquc9~3fD8q&o8 zpWZbu1?S_rMh{K3tWaMX2)@)3?M8hmG2ib39CQ_#5felmIQ-(|b86sJOrQ}T0l)Y3 zQqYRfU|sLJOv~^Q)Yr9gqqJ?2FSpw0FGt09xuawNgs(drLmS zeB^;6t0OTHBB)Dlk1jpNJchA~DlcMQX4Uro_;>^BFS1MZC9o%DWsg(|?BIGi<_oVV zcmvPPOZ7b1ck5RqtQrUOWHCgzv^B)Nc(LpQA7y<1xMCbbFw$ zW<3vM|BmNW#0RP@HQGxba-rqYsDiyLb8d!$kFEY;jiCX*to=_=RSNk2*13&640wLN zn#6$}xL08w$BWKZu=jJ5*hrSm}_m9#05MnQ0ZjAUHFCOO_w0F zhR@ipwt$c2?lbaGw}f8cZ5`nRyJ$CzjS-%Ur1xTx?^`iwUD$V-loHK>cDDQW|N3lGbc z3jX0bBjXi?A4S35<@yG!{@72j&2KpgKGya;hL;`juwTMms2lVBLxj8Qk{tf;*k1mP z7dRzB+yCS!^893kb;^FM^RpiKB?R44x>D~)19-db?d)kQ=(o)UdtbeV&U)mt8#m`` z+^0I#dpHWmR;e5=x|;n zzO4d>QBVH;$NvcaO{J7rka!0C*|E2g`Ve@?DJT9!@cm1#!V3k5QOBrFx}E~BpDzu& zqlZ>=Iz9aj;^}8lj;ILYsiA23xbZIdh56tcT3o;Q!4PRt;GLC+3#yUpTqOyc8|@uf)93e*>29$LnqTNrx1kSUsXSOt`>2~ zRZ9MsiW|C`*+C*>jBlaqQ1(NdHlaT566sqDn#D#Xa|eY3qM5!W4#yw_)8?>5)b zL*}se4L2+EPQ(HGQNy~|sJk4B%i8>aKUuH3KPut+W3*VFE(xK|oz`lnItTsjKuT)i zG1TJ~EUNoXfVZ#S*2)yd{xi?4885{1S#1MeANYH}d+w3550P*5uR0UD6ab2&kJuXE22U;GqOa@;j`}Ff& z;sEgPKdTNo{69PF%Dq#t^Kr@(l7#)4{2~U+>tx^q@qM(vNijbf@>kVJ5JxT-CQsv7 zk)D%}nG$u?NBPT@u>bdK=ObxPL04k!{-_Roie6C|paMQw@5p(p$RiKxGx_@IBEICT zYG&<#XIc93+oA9yv(e*0Il#@mzYTb+QTNonnxJmPeRccB^;8gle}3AZAw0KoSa(BH zwFvoVX8gTY0rFtbtgvk%@^YTe{+TlHBt`XDhL5Q0{8F^;<9{Z43i|`mkExNl#;MQ1 zrIZ5<$B?HFm#1|fMV!k`+A4AY4>X=-juD>s@ap4-@2kLxLD`{s{vPCUAx5K3{LjYE z#+M5Ht_dVx+N}W26m`)4LwoXHKx_>@@At0ptV6%{XPlom;{O4U8Q$7Y!~dKN&K53X z|Bc|?k7uBZeU*u_s>k!C1lDDleeoR6CxLUjzw!RpkVCGbQ5=ra2hCF4^3OO*FC7mV z`Uw6OLT=3omINqu&)?kSF zxA@h{YYcndwAVR*13XuMjwi*8P~Yz`$l!Om`+^7ib--i(g+6yxhCNj?H)Lf|Uu14{ z63YNj&L50fQp9?Ooh;`CZPaUT)n5vmg5OOT*iPR@y?6NsrPV#;@qf(uv!37qjg!hx zy%0}M=IqBjfIG~ZZ+Kk6>lCLctL>q4Manf*Ay3o>7d$n-4!#p=lJ2SpUhQo@a#t1q ze{#+{1mkFaeS^ync%f?1b%_MyXK%9ZoW%J8qSSgqeQ{k+pNRg8h5Z=PD3#uR zr17Lq`V5^*Kymr+OYkD6rctHRQmliq*%hv2V84{;x=Bww)?Y5w8u%ole*4VR#{CX? zXVZO&1NGo~0^@hpU%1bxgQ+(W_>$tAw4)7tyYIWTo{Ijxe8Z_lh_N5okkXoMKh~Q~ z_~yn?muCf?m^v&7e_|6aVOIk`{v)PZi+RyBVs>}Zg`K$0=u?Vfe

HQ#uFYz;A7( z55H#))YG`BkNL_WQw)H8X%?GiCm+GSmY&Mmu)9%LrRf(d=-EM&YBZX-PrfVU=R+~@ z;3*}IQhwmYa3U+=J|@}kg+Cb8fp?PBk{94F&vfMD{=y%)o~cd7Tmmi)%_J=_p`VkU zro>CAgAdm-zXwj=3LL-EPzPLIPX1$F1^wV<-{IY2LLPCc>&^qeDpg(X@K@!nJu68u*!LvED(RaCJ)EvYi11#zu48v|>4A4; z9c2#kh?}J%|CUnBZ)Fmnl+IK5Q-E4CGx$f@bEAV(xb9>LuY~D9@R%?Qa$d}Tx!KdI zE00lca{OLOc>sNiGf^(l5qfJvUAO`4;?U2+Gj5B0R)U9r8o^$7j{Ux55Q+J*yd$8I z4SU`elVHO6|9clwcC;2e?@9OP0mPwnqKMkyXW+a_ve7^*@P=9Scv3gkDV;6{Uq$?H z#jJG70T&ioduCoW!e4vqUl88+OTn)Hf)v+vXTOi#I{N*y{{7V|K4%15=8VCN2<_QAIU&9Gb83F9O(#E*{D=mfJW z{M?@?BwYY@duzcwcO3he)I;+{X%P>iv(~NfKkMR8E`+>)JRj)hSh^1t!S zp>lWRTYX!R(pOj)%6pN%_;VKbYcNut$(6u)HbDeJ&F8f zmw0570yrVbx|Fkwy2)*g&K3V#r0+5eCqX=&+EzSs0J@ZGr&#qd%)h4pb{}|3H&h|Q zI^Q_?L*ZOX@UQJRd$|z@!(Oumqu^=X6APEGLQi|scJx0^@Ri2?zh|E}foBe>OSTo^ z{@au>7E|ckX0oeCUP6!J_rCGx<36mHHQfv-?8bIilFxBk`BxIR_xCycewuP?|SjD3lAxIvMfurHIN zs(vFM@x8YEohumsKPq?Wn<+W+@UteKkHEXYXF+2JVc&y32j-f9C#BaDoov{^J9K5= zC~$#iY%Knz#C)we7hl;DM_m_kppRA-d}+RAmq!8d;hlN32dzm{yLhBB{Jd`MEEVu? z)bJ|pcRSP@pU$-F24R1?2f6s)m%ueU>rUky@YiSV&I`Gy*N@*yB}TidG0^n$75eQY zB4Y#I1kP+Yu@qw;4CR;7KIkm>9)EC;M%;2~NNksW1}}FypZNxHuQX8f;chMRVTMPr z&PV9AZEd@~b(lw!Q(?5N;3-E^SqaY{(0iJG>;d9mGJJz{yaRdbqQpMkddyeUzw?8L zcLik%*%h3xkMa1kec&7Yh6jEJqaU#u;zzIX`#BNIsq-UPe^8V;96bwM9veNlv4-pY z#h*I~eM@{gA#@z?-O(L?)Lq5qD1EV8ys&}WQQ9GvQf80`{7ZC%&ke^Nhph^{ppz{c zF<-fi_bY!IcdI@Mes=2j$Gh6g$bThy($n+cBZo~%BNvcw_PCbh|A9^zZF;e45%@Bk zn&=*3#G9oeL1nei<%h37&_RjY4rILhQSKj*sT?4-| zDhu@QM!&Zn=ALSR9mnLfiuu0*7urHYVurAucTRubD2_k%Fgax7Jh}ah#;4G)91W_`lBJiF@ONz>C5vEg_7L zH`Bsly%K)#iT+g)aCq--bohrTtS`>l^KbYN>UN<8(>s{w-?^S|Y~a7zUt8R)fUjS( zxHD|QD@1hOd$2t&dZ(V7^aSN!W^w5LwW1G*_g^aMcSve)aUo^DE|G266tr ze)^F*0gPLeR-sJ?yn26o=358&&zPA)9_&UM6CBWm>%Lzcagk3HJi79f5ve42c$L$< z0_Nd5v0Y@97xaMX_Nhq*f&2J8jVb1Z{ZNiQ=A|wnu5VNsdVaaarq>zp0Vf_mDI(+_ z<9z>4;H+TlV_wS!>|;CYe>x1j>PfutJ@*{!=YQ|9p$-1IEFy6=1g)2Pf#(76(Aqd5 zPj=w?At_F^L0tccuwE(Q{vwwc7p}YTUrt$3+gq5&TkR7R`33Mh?O%quh>!i5H3>_F z;M)`&MKKw;-#ORj{H+-98iByy=OTb(Hy%zB-luzCVz*x?9_wtiGAV~Lf$Kq1N62!3 z#|8Fn^a=2vz_XQ8@Q06&`M%zPfBu-1oZ`5ReH%+(OhaJrL$mFL|G;0wgpbde2Vr~~ znu`|^U!)3*Z$;5B@kFewG5YO1y-`E-9{zphB}oQwAxcwx|F5hj^YQ5Y1rNFABh)zzK2RdAJp&!6i}lIw0C>u^ zFIxw0A;0P_s$A?Pg}zRA@?GlM-UOUFJR!1zPnmpzsQ-%H@{932B*?DBm1DqMknHGZEfh2P)fekYZS zI7z>&YoiHXMpVZv`|dPw+x_SlLEsvniuv>l;I6hvh`YNY^0xGq^uWuQZ}!FSS55K# z!KSMA0Pv1-!Puo&sJB_S3PUU5PfX6F?eD-tNI!TeKLft_51s!4e|AQ?L({+tzPyjC<9uN4gnyyeOyrln8d*AAjzX+dAsRlLlecnD0he>jT`t zuNCQ(Svj-~aT@pRaNWBk2XA{q@1Lyf+FFO+??p_U@E7xArQOOrfPNF`yLVJKa36rm zko`NH&$!gKViS1U@y_k{4D5MLq`r6#ymg!-&&UTjlqbFArVAWn`+VoZ0bFmLsnxgl zumk;*6LSC52>F#b-2un#XNOMN0Ee!m{XF_o9_tVhf>GR<*DrVO>#E{9d4jW|$blo? z=gDpM-^4oLhn~^cdx*bL{-3da*xxds8(R?q{7Q85vkpW2KaZln77gCae=J`o5%|!^ z{l^3GHgZK$EvXD~xZbzwSqpqnYT>zF2V9&9N+Pd899zr^T?Ied;&02Q04{~4WS*+R z@!vGLlS?15uh`#d=5#ak1|k7hxi;V$Z}gZ#BlRu#aXxT9 zIP&NlobRFHzL=6GVLewqS)-4f+i|A)MEQDdfr6ufFAA9R zR1)6r7u2Wc&3M*P+Rl+E^0gp%*7to9)}oHmzaD;Ko)vJ!^Hf-yNT6p?o_Ji~1U}Xz z)jE|AelRMq4v7WHPjKz7F?aW(Dky(Sp0B4dXtvzr;1o- z|M&ajX<6vQ$>&`&fJbU0#~1%YJ=a@e!bI55#FJ+8L-~h`$x)+9pfgw z=d+0G+_$DY({Tg#@_){606Uo{KJ$1D{D{@I@DCKidhUrlkeU&_SoWh6>TnZzuUya6ylG zgC{6SBJbxdXDyUEG)Ck3TI2832+zfEnX%dV3A;_Mepw*` ze?42?ox+N7Xx6zkS<1k_gp2M(!>zr-i-o@XO`9z572=)7`2GyyM0Rd0xv&VhdVZ{+ zI0<#D@MOI-;=uaqEj1bk@KC1)4>6pVV%&M%!yLRe!_^`1CeBwEA9E4*r|=WjE`)tw zwHOj92O&OxaQ+pCe~BKuToO_ZyL@#YCrA7aHpzG@_Q5ary-lA79^dIrbY^^kJo!L# zAle=Iy5iqOUc||_JW2X4TwiIy#`mEFtONbKdWSL(>wD9`7J}X(-aaQSa~2~X&3Sr_ zm!W=^AS=(w2kw55k`;;rA3w%BycgpbWqqed{0R6_;QX2Jp0?CJ6E9LL@I$xT+nCQ0y>q`$R*zks1NFC zefkK`KiSJcahie^{4LC}Js1C%JVm~b26;4)WAyW9@M*fNwaZP=r+kX8h(5Xl{;VR; zkl>AVr_Mvic7nmDz84fsJb}J6G88r(j(yTEI4W{t@Enx3H^&L@Ll>ovIzbPeN4P$U zo)Y?$vU2W9H}bxzm+$E%tTS!;=QNE#PZQ?mZ8QdtnY?p*@*VQJHVtb=74rO`FO%4Q zBG`M7wCE5G*1xZe{uDctN9xl?Bv41$EWIP#7Z~x4>&F}T zvDenH(*k&foUpRbCG?{+ZnpP1+6<0h7GBsv-+16&555=pWfhDCXE0r*!C6>AD%zw%bZH;W|XBX*sew|jEH`xSowk%3?5D*mjwgnq;3n+Bz%;2&|c z#&d|@<4Rntk8%EzG-{tj;FRYF-bWS`;G?$u^nsM{%RK=jU#YSFSoiIjGVm|&l&16N-6Xd(T{4H+J_TVz@6#hqHVN$6+(sA2*+k@ zL%;BQQt!}a74TjQ`5wQ^z@gWz=}v@w8*^!4bA){iF-3e=$$-yMV-cp4cIbDQE=9nC zP%n5!+`S6CWDt22sD<^UeEz;|71Uw7BYE?%-$G5?%_ZQ5_~)Vce+pQiXa263hu^te zw@rGAev3b{Q+@;AObxofpYU9m6MTugFP*{1SYkCYVc&I?KTnqshgtWm`>LZ+5Bn!n ze@TOmnNEIc_brYi_y0;m9LmN8-z_acJ!{L^Q&WWT{nB+N?9(YRy7J8DJ#apL_NW}< z)GF$8qT>hbGvc>AfAb^uJ+X`4e+phD<(jXURDgAw{E)k4uTl4Sm~L^Sf8u?0JI&z9 z01@m|Kf!mrNdo@z2juCpZ?>g)W3?3(uq5+rD3wzPfz9{yUhV}9{T2^%Y4_D5EqX}Oc?*-K0K0)Tt!@$rIoOf8F-co&05i4 z#Fco8GSe*Phho64Q$L?juM`ZpW@2B;xfu(SWZ>(KE@!PI@beYCk1i4RqUj>5L4KOP z6?UgI6uO*&=K)7A_?fUb%X#>rjjZkurEAcWWX2_Vb&;P!o)?m#rSJVDY7ake8!#gw zy!ZX-G?PmJ;^8WDFt3&i;{ImDg(djw&`x>ofGfsv)ggXAJ`d_*7D>H}dNego-IdTP z-FhPh|CXb_$83oIub8n1*xC?y>K0`U`mIk=+A>C5q{nW*{)BN1alI`4W&l2s&+f~i z13uZ79d;7!PW?+CI(%<0GPAkt1iekahAk)z>#LpYR5FNTs@#9w+L;#eOy-#Qn}zey!putQUnUeeXYw8U59Y;P8G*ZHH#ow-0_V?Vg!nWw zAm8%(5dT2ya98))OIqm2`BqCAlo-c}BNwvK{*(^a+Cgi&q8oLc4*c@u!y4_=z^j_M z%G`_4X%2a08Ui=czS@sli{W?Ys8@VXB7VO!-lfO5HmP6#h!BOJz2)#Tfj#7y7M+J- zSJ7cJx5sAi&t3A(Z_?POl|jFshZTHzj6cf+xK|~WdZ7upSS2RLqCyY+rls#)LBG!W z!P2xBpm$1ql+6*xI;E!I+(8^i7-}X80+-eDXg%&Ak2Gs(Fja#m{XA3?M0mbx{j;UL$`P)*)yet)1hs|0a1w(EBa&D)WbV!h3|CI;4!4 zA+IJB2IYw%f7vKfJ=bMH+#Yqyk(7cT|0FXkGet|57V-@K6l$hD9OnU^Jj|Bx0RDFR zTlrk8Bj)>bs9hHPS8PE&_XfegmMh|KfPWT(rP=sR>1EQ~= z@I7V!pCnt@OaBh-zS}0iJv|?5bNE;HIqwEu_{qKbUCC+Ke>F`@R7nf*Q`}kb6X%O& zsbAJW9LZ<1CXEzhoxXJDCP@Qu-#OHVq6T$4Cxyg6#Gk-GvIrfgw&s&>waCuJR#2Fw>C9uy_Lx7z3i8VSMa)hoi6Q;k@k~by>pDMeP%} zB$&|uwbeu0-~|j8`;wQx;(4{pl*H`qSl9dYLG~kbtiP5tEq?f(nsQuZ?-8tz{XEKa z1o5!b=QPT}3!J>Wa*_HV>M1*MDi!Fp4J9|ee67TMKBK(k2t8Nhl{fuI9A8e5HKncw z4~_vo7ps zYUweM#(2zM>@X3Yw|1@P1cMgh%(KGQgdXc$R#y`SI8o1V^!ghnLig%3IK_Pd@l(Ht z@0}Jm>>)g5^GXr-QB57TzlHg9Tv(*zl11GnRgyTzjJ&pbQn>}!`O|gT{{eWu<=&-N zO5knRh0oo60v^}Ll*Ci{4fPVS9o=WNy9ekt_rdS!qo}nMq0gwy85u|rLodr#q2eUP ze$cy$aXc6YEoMfj`BI6QEc1mkNG>KN(EZFnSlLF?^{Lu#DCxwvBl!=5DyIHSDJVNp?{qHbcGtY zZ6lXIbk8Xj%8@e4=A3wgL=-E zk+wY#$KO3mBdp(H-HG4k$7&9qA5>t!#g&0NV2@A#UmP=DD>}kb4m(Bmv|sPUz6~`R zE0<~H{l2cYs7-<&uLpYJIS%Ki%N=NrU_aG=x5O8qM?GJtNQ;JEWzwFzPeIC2`kyH& zIs0Wt=rVhW_Nrk&y+Gq|wX&nM0de)z)I~?>O{x=eG-n*8*SY?VQPVj}w`<$$+F>77 z+BG(sNbomzqi_1o+bq-(e6v|FS}xKdf1kN)%)ea*d+1aF{PZ!`(Vy^-zjus|NTh+!Kd)hY1b_Cv zIreln0ORoXl$djcj$t2NUIzaQ8qJ#yF#`_R2ry;bfG$YKG(V4cs9-f~l|>#auW!iy z=?p)8G8ry*AN9vlL`8%*cxys;sJ1V36?IaIe8flGd2+h!5R6lMZyYb$#i>Bc3%BD&GOG;jeT{tiN@(L~5kcRbl&pCL{z=Jod^i;P z7U_BW+vbQnQw4WR3GBlN;!Ymo0MFU2)D$`kU2-m}JQJUnkN*-WR>Hbz*NfLJlF-YC z+Bs`Z!w%Iur!J6Ty)58M-wEjAZzs=gQUiCjlmkD@0e2hOSwoj7z(btu$Qr<7COF5_ zov3kNLEs)!D{{;aH^l)@@Gv!MvB$b->xic=*ML|2Aj{Aa0Y3ZvlPz|`|9#V2uf!u? z=o_azd4YT&{KEfu9wYP<_j^B#_rSkWGNy7#;YYi4W`3-|=jcP#5sIkyH2Xzg7(wq^ zncE^k9>3{eaGHr9ZG76d1$yM?t`XrujDJ5%_NxUV`1#ekjD8%y9`jhZi*W{zU16g~ z9wr&KHgrA?|9SW;Q1meDXWTei3Eg9sbA4Ye)<5L3o7Y)i<33A&@r(~ok!KU|x@>>w zRAqfO6npPX<&q9e8-(%kLW1BAfBY!-5@w0qU1AN1Vaj*}3ta!eUODqArEavYXvSjc`s^F}K zVANM^pAAph0UrymnAYnd4!Of4p37mr+b@h83WA48WiW>#AL;f)<6{~M?uH*9;3%F4aG0;Vwgt~S{d!_K7raZPMD_mdT)fBN=gI26JgiTZCv(M? zysQ&{_Aem5 z#={p+&%keS*LpqSdFVW)mOpLO2)e+t)Bj1Kel{P{*`P;#&O$d9wV$SKxrEpA6F-Hssx-B5C_Ej{vQ%fma>UlU*;1C*bouRW$s8C2rW`?Fi!V{OMO)TUZabA{D+4{Xza& zm1OA}aJTW~*32kyZs)d}btC%!dRXCpK4BlfujXzn@>1MEhCmHZ8F2G)YR)ogy3jhyq`p_tX4}~V@q_zY1B-&hJRM3+C z8NDaS0bW!yuETd8`$bAwMhk>d-|1e;h`k7Z`y8#;A&R(QPmOb?p zcBVPU?EV1t&a0oP6>g}%NS=lYd*S<2i~RTe5vM_Ja{7;vA5~kVo&o3QJ_>LAL%uot z=Jwxd#6{~1EBn2V2=SINXNmuZdhle~A?|%|vb^2A1s!?YzK_`gb-aCXOr$;X!#a4X>Bix?*3t?Tw3W`%hy1&oDmvAfKc3_?%4^xtOE$a`+J!c%)uyLHlB;X+RSEi&HGzE)V;%9t7P>SY~#VX5_f~;sEx? z|2N#SHiq_T<_<{@;r_+&L&sC0bD3MR+)Bc}`K*Nx-dk8#)Dgd3OoI0)K1k-FX2Q6X zZx>DzgO7xmT&19&!u{afqsK+Zu|J2@Yx%(h`1(@7sy+O6+t_YZXc&H)DSfSd5c>K5 zadh4BT)l1BmKhb2QL-YdGD^q_WrZXoKU-F)h=e4Cls&S_h>(>nGg&P&$`&DeWJSE! z_x%O1o1pKix`G&kLV^Jp^?A+HaE(wp%uqP{Ds#Ack7`s{*2)tJF zQzzf10qC#f7v`5gG5<^2TuQiaE@j|%QM4^_@AiJ4#5^-tR_N>w@0&{VpgtgmDPDN)hD)xBiV$RuUm|map_-@tfU* z9`}w#hvI%b%)<*}7?+jd;&>d!apgs)Tq*kPcBJ~)lUC$4R9@r>)W9FtE>XWOg}oEz z7v2NC6D_eXC%oq^HJL^$ClPuX!WeWR9Q6j*1n%`iPW3~14{$>6dCg6I`&@uCNLSCz zLJl?QKkN`e?w$=g9XN*XC4bO7xd*#2@nWs?C-m3c#^3%7J?N@~_q8&RB>^_+SzTV#VUu-<$uGbys-SGTh9~qp^KpzB}(xn8^k8Q6< zRIU%eoA*C0%16sFz45*mt>}1K-%;qvfh`>|)%)P5>a1ww;pdV%Vs}41haPL65mqS# z&h|7O;ckYWd2+EZe1twJ{uf^g{q3a<3Cs-vFM2EIWVJJkWnMioUrKIzhg&^koX*tT}I| zM`XaIj%kJR@B_Iqy)QmdVw`#nf3;|U*PEHLMByifXG; zG0f}!sk|w)b0Ksy)L8!)3Q7r6I^eaRE_wChI^hSo#v{;|w=MEn=3bBoPa-b@f26aX zrBAAl`0b-fWRwK>Lk?ZL4Q}*r_>vTzFmU6i?KLULS4?r(e?#cUxrvCp{1WtQ;oBGs z?5yl-_uwjJ+i|1$&fa`E|~=7X20ctUUS#e)%!e--#IT zGGzNh^3abH%Yvu!4G@QTUQd`52hV&(In$dN<4_hT8HT)?HuT$ff+tcjE6I7%j5_3f z8%xK5V~(6484bhl?|wPIDq)0v?f;M6hzI;>;Q6bJm}gg|g5y1yXVag#4pAh)o1?KM zSMfPDfa{+!$i@3`21$Vm;J5u#x*NdVDgNxIG<#8x-dUWkHHiJW z%g?!mfWt5Cs9Y7E!hQ+vfzi9rr|N*~2PGiCDj#p|UgkqwKz*k^K^plEo@1$RFb^&F z6UB7V-|JLo^v{A1%e)&q9Sl5`dU`p?1pJu}`=4$e;J*6}CX0mkHC*NU$TkgrO<-|l zl^xIJT&gzghkOb7Fa@n64&l=X+i5uhdl>mC;=*CX(GM&o)eb>Eb-gZW;CGKDUQJ3) z-@abW{$X_KkB?a){BbFH8wvI_#r3QRI31So^AzYGyIHx zYUTaVP4HC4?Riz;9b81j(z4NB4$Ca;+QR*W-?%7@fY*MZ`TN92tWTD(?Lr0kg6AD2 zg0Eq({&SD;g1p<6+>N*lIc5FSRPw|I>zeqn^U5{wVG<%QZH(X#^ILfjUqSxtI&Yhk z2I6Kdi7y6nu#X~-6eLeTZhVH{H9`;C3e?F1F|YOHZ%A{6;K!bJkE{Yuy)$&oZBYWR zvF&8=Llt~ghTAziw8X5<>>g^s>9S@u=XAjDcFlYf!t)s)r|qADou`YvDxI7L|5fI# zMcBvk&i@rhI{a3tc-^g+rHBXKr}Plc4^OD%D&Ii{UMNE$!hJM`1TR1TO5`IREKl^(W_+wRLQUdOZ zw9h(p#{=d z=P$_A!44!CHq$o&SMR87e`~;X?bf#28BAGTnc+W+wX=tfbwv)Sm6M|SB- zI{F!YHT!2K;vl&fdNb&!s;b$$cWuBQ1yn0(9Y zEPpt-l9c&`vpn@5W9}c|ue6>>9!N)UpZ%a3f=RW zyWp=bn!T5d04{SX@HG_Ta+W_NsjBpx1$o9{)d*tnVsmXK#5+9B@?)##|K^A|%gc^^ z^gSx-jQ260^w$ONL))G5iRNz#Bll6{9IB$$+b|5hd`PT2% zQZLehyPjyASUtCmI*-qN^>2V1{~fIPa(NE%(fU)vEj%y9@J3Vv#&a_tuO<8hITEiv zC0B(y1ii7bh_}F5L#MsEA!m#fLep(n*C#B&>?DxuH(AKIQl>BPOl*3TSy;p%m;tL{+ytQ?`!ZcltLB*=4ja#I1GysNB11a zBFb$*JYW9N;{*JonyprkA^eI;rs1IkX2_dgg6%&Z@PHzvVuU)f<^WIC^Q?#uLrUgU z7~!|qN>ZKSU&>t#O^)ER)=l*dm;Jz96-lyg```x!10#0fpE7SZU0dA3`8$sBWMS|_ zmy)W|JMi2;awfOmrXfFQeVKDT5dD=q5kKaM{pPM&m(0)_4v6fr3~-Wnb{DHN1OEDV zlFh{`9p^2bw*9*Uzqz?Ln>H>3by=JIZtl2GmZ#}TIdE5jd)uu_d@t?e`mh{0>!Abd zTsHjOOZKN!`w4Z!ALb7c0hiw4YjF@Dga3K+seT6S_r9f1myoypr#%1K3-cN0#hIKr z0sm`Lp_mGsU`VshbPc#bTKch1BG!{b=woydgII ziKRjhAA#KaZP-{~UMwhyJv%XfKeEPeM#8^1E(x900bW`pE>Itqg}jawKHXA+{``9| zKn_2$O|i004gdMmk8Yk4|7-c4C`#ZLIWL-Nm*ReRxMv^4vB9sL+WI=@oH11iO7ra_7Mp*qflhY}Kvr;J*yCr{>WbwmE6}^#Pv^xgC(j?1~R#LtL0M_A`$)f)6fGeCzShYxYCDZ`n2g1~cHz3<<_E<8NhWp(Zd@~Pox zxn%HMFWqMTF6iSW9a)Ksz?*cna%+S-?dPY{YYdL)HPQt&Yxu2z zxfrF)_rUu$MPDb1@Z77UWE(HwFOroh;_;k4*CWTj-i97<+%omChn|P63th%~9pXJL zJ8>O2?N>?nJl4&_H!zh;55F&$ekSbS71a-f>2y9Rcall);^h8OhXjHAMfaEx2} z&;90Cu(yjXbYq2(+mokK;(#|^ToJz?i8hdn+H4BrSYB5QYRrYd86Z3x{?4rb;?X?h zS=N8wd<{I-z2GPu*@?I}{GX%g5cF}CMWYx0m5Jm^BAg?ta_OzqU(AaN#h%K)@H;^f z!ks-C@D~ABkEO(59LXA^Ctw$H_}&!vdc#f{oS1g?0T1rWag!zp@_M16>qr9DEk)7Y zssME@Mh#ha;ZMwX%NW&x58isy2zKK+vI?TNXFempRq;njvk^E!HT%(L_`N^x4{Y%v zep-Dm{;c#3{?AZ$+dT*JSf1#@4jiV_{`#OE{M4xrq0e(C5SM#0nRsu*51tH-(*VC@ zQ`VE%3|@&V@OHTga2D^V8OMF(3Ev+-@!}HjPXfgTn>s$v+}xXU89dd|UpLFo18)uM zNuOayz5CKXh7vyDGP8X0^;f`Ax6U!X3**3jpN%}WhFqP@Q4}%<{?ejcr7!{?_Up^l zhO6Mc?l`jilgE8*lZeH%aQ;JY+&QCTz$?Y4cpXUAz{~E2TT4Oys$B1@5zYa-C;VSA zAz%GSqeD#g7uGN7Yss5Y*ip~rP`*L%qm>0O2s~D*nzQslw8vTUAN@kR+tsV8gmqIR z>&kV$c|m8SsjIOb_azAFj-ng5|!WQ2;@(NM=i6vH0H&hd^^KJ=ocRWp~;Vk^j!*tR6=>G|>D<*U;h#P2x^fn+z z$F>9WQy`CzbbmcP2ssuhl4&NqN0&pmrXvCE&((LcRcM9xQ0eDE4;#q;CTqn4cX>5l z%6$r4ub4ia_Xv3?ai4I%0L1eReXEVZz&RH``<{+MKGfcpy)+s7034s~U&+LM9y2B9 z=EGk_-#6)le%xqpF*^nM60-7c?1p?F747{)-UK;j>@pn znnKSUBG@F+KJ<(hV6a9U*2zn@2Y&Y#sY~2bWAF}#yQ$<FJ;2muKB}yGaJqmZlXP0hDVHG zbv)`X1-M_pk7l!QZ~#Aj`UI9PNw$v#}fWLcx@D|%Qv_F))MiM8%@0|~N z$p*ifKKio%Cq55v-z)0DI<=Se59q03UY?AIue)I$tnTK1z6(28t*H=T1UWE?rXLjo zzV@Urx54`GAFR0Y>@V=#09_uT-dRXFbpaj2Pdgia_g!N`2x1+pI0sfDc zjYnfI>Z9cgob0jgD$B%jJI-sgd=hE$ z6?p`yLBEU8uPKr7R|lZSC)|5#oS~mVMnC%7T+yF{0?%FbfDfg8tz(1{hm0QM*(8VE z*Xn=DwV=mZWzH>}PsE(rFjx7eeuQ2|rwFyHiz?VvY)Tai3qn1sHE**V?^Vybj zel%s_{;hVIVUR!f`$-FukcU~_``>GLV8;RqGC5B}9_}tu8cD)mp7=17aSZxHA!WlDVk$>e;oXe zfac@c9@KX&*-}4;oD_FHi5-P~&HMXIJ)j7O%vLp(=+>}K5@THU z@}}aa$OikdE#p%iBm+FP{2-L+68tVn+{Iig#2?Y3J-4B6vLk=e^d3SUpFIh?3cqn+ zfU+gx74F;p>J>>Lc%ILftxvrLUa}>6Uz>lJI z8c)#{>fKfIs6qTV%(_0`iu~raq>_XE@IOQf3F5y|4`y23{Am{UK2`4u!!Pj49_1q( zy=ZAe|9?(A^YPanS-8(ysw=C`8|eGP`{x@H;O~0e+D|?s@CeO^8sUc$bNfE|Jpn#) z{j2lyIrx*pQa4%jPb`2@(ybACN!EX)6!UJ}_42vI2=Y}+caP_yt&f=8rtHJGB7V$C zwn1+fHRw-6pKY?!n7OeY4H>~{lZ_9r>(#72m8=u>NV?ulJ0D*ScI@yAlh$eJ;XcwjVsy`&*nzEx=D5 zu_}}#z)RyM+MTw*NBwfNczZ;#9&+r4^M<1@iUhdp{61ReQtu`#dY7u;>qJK;E9QITGnXsjt z0gjCS?6^A(e=U=zV2|%}OaH3nWBt-xE-$Q40S~-X9BM{ulygWrjU@1AdRx=2|8U+{;FqaggCoxJmQ9+x*Rao$oqKNvE#|2_R7iLTcx*?y zaV>Toc1qJBKN8P-O?UulPc;M&P30g(M8;57`1J875GyA%+{a==AVruMnw#H z-R@v5!TqRHQ1i}^rNVfZ=iV0X#W>=kzhxW(ZY;VdnI-_9aDw>sH&O8AdV@D*VP`|? z&py$@b=R8?zaoX-I^8u>IrZ=Qvl9RF~MHZdT>$)(_yDB=4?!eTcIq)7+}Y!T0=omPaT03%Fpadq9sE_AFG2 z=m{(Qm@l8EhcIx2a*%C4?Bp)5Zavop>~|@2(y7#hJXv6svg~JeJUKf2ccn zE+YC2X7taLXshX1B+k8hWZV!0Jmnd^uQ?Jk9*z-PoZT9v?87PiNu zq)-QB)0fc@i_a8{=HVs4ua>TXMZd5vkE1D)Po2Ylybh@b6WD#8Z)YR z_H#BO0{N>V@h3(~=vP&OOfTWRZHl+<#VdnnIecPBUKakD&bQO=PaX2SJ(+`am`66I z{k4X;Ps2Aci4aoAQ{$|*9sE-q+=__=b#i!K@S|8)bn^e82MQ;U-DnqF%P!} zFBT_Y9zGv4ir#^IE!D~1oZH1YNebVJ{y|;@Ca<>;>Q-ijiuaAeUeww4RZ9e696_(t zavWecSB?eqX#p3idWIf?{%o?_bCyv<&z{M51djo))$UyC{eW`|(gs!7fTJoKns>w# zP#<6H;}G~1a-CCOp!fthtWlL(9P%M8XYWdzkNNJOZe4=htHfMla6`YV2fYt7fM;?f z;tU|*!87fq^q-*zB$RBqf;5l=<$a^vd*Ju_9vw+Qp3*0cnJi%#I8(gZ*zptAi_5yz z1UM^dnfO2N3d8|3j(R`3A-@ORM2N}2OOYog*NXs87-{i3DnL2dCEAPK1nC!j5p5|FeApz4|eI?bQtQ$j;YU@yTV(!!6}>Y3LVo)Dk`UJ@^UInf4vX zg@~brCus)8&8cL{TMph!Vq)VF#_xUpkQ?DWIaBOK>Rv_Q@oM5LbdHu) z*fWN8$gF<55A(D=^C?0C|Gz0cFX9Az)Dad*^$h-pY3QB*iC4e_I}>MkW5C~ul@1L( z1>TZx>odkWSu99J--7?tPWaq4od-Me%ygv=bzcXTxE{mowRujA}lv zFR~Mj15aE!@oNE%j!&bd>ezP}?$l*810IZjDC6L+kh8o= z6n&~Ac&pv_!fdfx&hq<%qFbUawE5;7u2X98|M75i8^^j)-+ckw6`@boART-2X9u} zk>I)xhK_!HTvz&^+yirr?}qcqD8VJf{h{AgooApocjr!IU>+#VdcNpmUaeK%(23*! zwL)IkGr?0?K1#fl3LNFNnAGD7+*rAz>Jb6FSSs;h*%1A7&{h&30p2P%QRWW8{207$ z7g56XF*XbQ#gkY+*`!Oa2Z8_IvQ)>Q<+(iEQU`g-%eoQu7y30Y+Wor{|MT|cz0uSI zznNbeRt$MeFxFw9$b=mon)-15IoA2prvMko$-&GXmtxpGeFc6sUbM;Wg(Kw9r}pnF z6OYhd+*pl#8;p2CNyAG!1a{xUURoA7>+&b-58|-*hV&YDMqtO!r5~dnN&(Jk-nzkr zxLN##j+_AGlTz2VLoNgI{dUxu4{b<1hus?bQAK-9s6Q9D;$ublH1N9GFFMZ$kh27> zIHFgDh$}0kSCW$;|A!4sZuHzO6~@6bv#^O$X+Jt)ddU48(# zV(~|82od=1NtG4}#H9}$#1w<6u)Yty!u5}!e}-QM4@n??h#QVHRs$cUhe;++E(#Dx7Zf1{eFruTtAW1|ggV1?azROMhT2*39%P0kK>ha;fwgv)t+uD@-2 z5Z5WY6;fMq!v2ih*BC;4t$t?r!%g^wGK=E2yEVuQ=I*=YgnZf4kY0aRU%Y?$`uGs3 zG3?SmY|g@7G=3Ijjquv(Y&l>wx#^4Dtk%!w-p*Rz8m}L0(PBr*#^B z>j>549~F#uGf%Yli!AKuH*WSYL*OV9S;~A{^tW7AAZ8rM1ACqD&$~v z;UhcdA&SMCe**rO{56Na))&O{oUT**-og(RD5}3phClx09{V5s-qNbqt0SJk5lRsq zQ7-VyL-psr0B;ekuzpB>fb*`tbN#0mf&3FAzl|wyRri}=|5dw1_L7h^sCYJ~ZvH*DG4JO8X5>S_1Ns@?P*gx-ki22YKpSJ8qJoSl>x9^oAaE#sU$0OG8m%sV~n}VTd|23ZZ zT#P)3#Yy4r-&pTyyYVvky-ZiT_%KUn`A1fK@8jLzKfQB_`Ys{A^O)**0OE9s@eb+!3{FREX(pO$EbANZGGb?qbUP06j#%3bgi2IpzYP#LcA+Fy4bosX(?BtE_y3cIDQ=AP^yo_;OxYDt)7p+R+#WhxZU&>)%Mc6m;SKaHb zl^5*%Ly{w3!V&-e)x9yCg?LusQpzXzsj&)&nol3lU(vbxlv>oS<%Hiz!o1uF{qal< zeqmwbihUFMCEj_?Q61yleb4dweFyX*N4sVB8|;5ajwe?)@YCewUFi(XO(n>~BZ z_(5N|`-dMq3PPSfUT&-H8SMS9a>e{))Ej$_F4O`ST?^PLA8iF*pSqme2fuvLw7dDz zEb>-2$sd|6VLi?llp4$czt!I448%Ir3rE~y{si2%D{xD;8u}||Y)&}0JnZ~h(=Xtw zuC}0;pBrJ1rAws!Fpip9YHL!gm;SZHktYt*<4}4WtLvOJGeC7Pc>kQ#MEX7mXXQc7H!RJ_B zPsrQ0erP{6c&Q=Y!hoN^S4}Z4N*kJZ4`Q2+f{;GWeR%(L_#5PJruVjSt_seFA3sDQ z2>k#3LP3E60jIsJ;QET^EtCmcs{n8H^yDQoBTx69=0p4{KFi+~HL^vW6Ysb3=peMS zk&=?5Xd9XKmu#WVoSrQAsWx~h);a^tIpCi6lrHBdmVuw##ZEX(gWp>n^f)((ymcu# z-z$ta!_!)>iVXOv%||~AeAVK^>%$e`d7aET&zWN!UtRP&YQ@0oeG7Qd0Nl89-O{rF z_)2s?!$bu5zpKaSQVHj((z2NReLe!Y3#=;P!8{YQULM@RI{9%E9XK@(K4#PXsVnBW zK}29a2l}R{X&p{D=j$M^=i$?kM_0B`{;$A2Zn9ss45LslBFP_T`3Ul5lu%3HfxGn` zHY9H2_fO{^Z@Yr`y{YFbbQ5{3KS}?@phurl&FEOXQP20K(zWd|?8<)goNmY+1=mxF zxM<|lMnXSR#=)NKXn!D1LcD6(s@s^3IHFsN?szs@&a-?YS?~|4odF9O*!TOnfuja( zx#wu7Gk$N4{6*3J26?~43pp1uasBJD->SG@fuFJPCqK;Rb<&cbwum$NrA^hepa&XO zgFZ4C|0u=8%`=Eoj6{^V6rj(yKWDvH0zWBmj^?fe;KiB6fwKs$b zyujyvZo>HlciSFlSKxW)oN}c@WicPR0Wnd+h)amu_z3mCm2ubYg<(&djo;ykw|;?+};C8M0+Gv7?7bk2cSBcdOaZvpZLo9gaS$VV}qRIk}sR zgaFr#NQ$%jB%+@Ga3hZ+`YC%jg~`+ke3aO)pPzNH-*NSCgrg4Dv5IsgM-S(9(lAE{ zUjpuR<23752anRqnxcOZ_1TO1^XX{K9y$CW$8~!Y-$)0$U_P7lGl-jDY{LI@4cxE$ z!vKGFxPhn`c%s^Kc&}+Kc*%(ZYo1K(tJ|||qn(OzU9UQARYu@jsoI->Z^I)d{W5W# zSk^0pV`pK1&Q&UuTm{d2cyneLa-Wwc(`yU;Rd&8URw9KqmV_%9;|TPPJG;vQ|M${i z{TTH0ZJMQI74#se^Ij$caP7@MlKjV0pa*Ugk&N!pgByab9)qx8%kdutk z_z)K0>C5A`S)6OQF4^qm>TjGc;!OVZH~6{>7YFUNAz$|_gp4U5|3{Z+YOSyi_~8q3%fPoePNfF3tMJse@OTB7Zr9@#~9zJ-vJabxwJ=GYRKkYViBdHk-pPW$7ys z^0tYxUdjgW&tYOq_qm6GFY>!;4#5x2)4fz5RCktdW?q`ly#s%+PxPALE#Rz6hWC=e z8+<&zviNrmxHR$GF>3hXseQr6Yk`A)guV@yMq7Ja?!ozY;M1LbA`RNWvyqwID;~u< zw`Qae{JxzQb5-0t__48u=sR=3D;&D-M&Q31S$Us&Oo30MEA8TdU$NE@Q=NgodD%2{ zKJ*LhY|M6aat-P^WgKtm=ff_GT${QJJKi*BRV@N}BXu)*<(~-Lbq_`zYx5@_z-f$< zAEw!U!R}aSACU*Hau<(#)3OYn@LJ1N{~6%lBI@aItaDu0i#^qys1GafqY^?tWYbcG zf7YXZz{uXR2Rci1kddNvJeI9x>eV_T>oV?~d-|k}LyvNU-Xi+y<_?E-u8fbQ1C< zc9om~`0CGqy^js>(I#_`&8mpAe4e(5fj;n+mZs-nHSkqW_0o5Rz+Z{(r$4o+hwCno z?P&ncy1;V7i2S0neC?$thX?V0f%l_UKX85G=ApTI)N$>n`_*wCcxzu759jIq&hj~d zWHXO}qlWG*YRJ+dA36D5j)1R%q{M5AfWsurl6$u)f&U&E#Y^qL{=_WR67qi`?Nzc; zn7^x82W>AvevjVpsk8VC|7)q}WdeN}SlgdfgZ|I0i!?h)I?KzYo#u~{#yJ$kDOWb2 zFXO)!B&UEYE5&TW#*i=7;yU_I0nb(Gl{iX<`}93*pSbZG&)cHn?uOhy_tz~i#pj3_ z)^PF#;P|O@+BUQrhvVm5ClH?}s7YODhg}Ukdu{-@_+{Ybum;FO`}Io+8jx$@U4ET~ z2dI}I;^>`qMO;f`BvfjR`?DlFynr3lnqa>5#~Ausx$oW4|8TuZN_XpZ#2-#>0nN7v zanE$bIWN>(IdIXp`ocaENi{hIfDZ_W*5(aEf5=+42>Jb?mPDBW;3Zn$<3khB!>1&Z z62=iS!{ z=ax@;^zJ3RABLT=I3`^Va_t};;|71JxkPea0eDIz^`DCIDd0;(m#iROjNh89xQZV6 zPznv1CGZ%%KD~uOOYrydnk`navl*S-ISTL}*9-JTgF@pf9@~ymMaK;jAWn8^Q$<&up}c{PXzfhBQ3It{n+m`Xkjr! zg?t_7kl}3xj8n|f-G>K!!*`uGY8Oz?RlR(!{2}7^r;qn=b)bGEceW?!5aLSv4VEnQ zZ->sLtMn%N75hA!@Lrf9kp;mm8{oa8X3N$X$JCqjJU8GDPfrs10r;s?F^6N^F+T;W zowpwr;C*JM9f`N$Z^``TnTDPs@3&VpoWlcni}ii^Wk=uz5sr(M@P8iEN9ZZNQCFq9 zHhlXT_$XBg>DdJ2??yDQ*}Xvh)PzS*YYghy$y3wSAK`r~ON@Mn-Qh1QxAa|cefZyT z3HF=dH=H?6Nda#X?akz_%>u7Ct$F`Oo0B{j+g8Ex1-!TD_fKIP3gB}$*TF4}^S0g8 zOs^R1*fq5%+4JB@>}AKZRN?#j2 zex=KLyiv|5}U5{|X?+lNxFe;*z5&st5cmVmPBG3Jg@w>Kv(Jb9@%*)Ib zY87pa%dqctjvM%r zn_8s&#`?xO#%#&VAP(RtrwsybnvAcbxceJ%&9Abn%HX|nF3<^T_oCkY+km@I5AvS} zZAe{!`})5Mu#Ca3j9;O`}w`0A8VFZ*rd zH5u&a+uEJsl3*$aU<4zf_cF z$?DgP)%g>VDb9laj3Q`>E?vYufmK;_bHwzWxEfqO0q30e*+|{JPNOB;v@! z4X?-g5Z{IgzYqBUKT!Ba|JiHc#_^amj|ku_>TjfBA*esoA zGxyHJaNN&O=p#SY%Urg6b@d8Jme!Y{9xUk2u;lr>;usD zw2iMt9I5hYEvN$fkJtsWlQS_dYs%rJk%+Sl-V&QXLR@TnKWOJ6c&m+Z$sb|xm&yl; z3^P!lzs=yFjOz_cVvpqafKRURQ#=Zsx~&z?H@FJ?)xN^ufqB+4Y&R8NCah22dwSr6 zlL8Zte}Cfsd%UAB{y;v2R*tiJgwHxBXffZ%)$BIuhOsVET>gW&|EYQTGpxW@sSmH4vOr$;b@UDL z0Dlw(2o#+}UeLwPwax~-&S9tHH{y>YKNr_fT!r7Qtt1pF@%!)2)LB#1vr{aP#JmN6 zmHSH|F3Ee)KdJ3vZx0=O+X zO8Cw@@I{mN?W+jqO3aQ`M}{F!7|LOG)EV++BIZl03S8A+P~sQ>yhVK~pO}aW=XU8| z*2;stxv!?X5%vR~5{edy!+g@e-rK>v4ZrzAC{YL3DK}ExFh?HH^vT{QY`{~hj7I;R zR|cQ9vHI8G0_ykw9uH*%KHOm#_@{~QM=4V08ZqwL`I^)R;Jbomzw|hwAH`ZfcI3!ul zrVIan_d%Vy0pz|iQbN%L_xBy$eP{~YL{4&Y&J6KJn39ki@K@9u_ZQ6W;B6W!GK&Kc zUkC}EW`^C?-6R#7dB8(VLx?x*D&5^iazFHMXv*Rye$W2r zs~&{@X-1vDq5-+iGgw|$@<7}%c^mTKYm=KRpx?^!3D z4npsANe2SaK6Dw9upx0oGV|_ zTiup~yjrLK_M+yc8wdIy^E%}AT^`t%hh2x; zfG_n)0;K2Q*Ht&g_X(puW-hX{fV&j)llRWOEd#jJiGJ^TxRbp1Z>sfWFU;$i23`|q z@E_{tdMm(1o)>x!H2~*5D19d_2S5E;$K}HQT;vx|Nw5AbMEz8;v5hM3^WFJ{Iddp@ zirV9`f?Iv5~J6_=@9!bP5mpS-Z5J{ox7DX|k(l`fi21<26rszvR;It9 zBtafhJ>BHoxTE~`DH)&1K}UHGpRXOGBaZUo3$z(kKON=wd~Ba)M4SHBkA4x~ziHQ^ zHyLu254%FVAcc1GeAM-gX-D}{lGx`zDNqNM5~);v41QnA@?D1pc-M**>xkRHpG&{@ zsw4uBnj9Mb1zt(^;N(W~FZ}Q4&GP5Kld&Rx^cv99af`|HA^4T!cFYaE(0}PXp(Y{t zyTruN{8M?D4~MiR&NAeYdX~v{3h=*gb$P__E2>T_rsI%Hc8xl3T3+N`xF4J;1<(5| zVWu-2^Kh-Zo*_Dj@cv$vwxp-1kK_6-qk!-2j&u1pwWE&ik@2Ah;FeX^4DlAo%|72u zFT#6;jUQ?Ryg;1u@r+y294XeNxw^KH6Zno^f_Fy}xT{Zmd>ObdBgnGb9eUNL+hXs& z1itJZMacy48!^Sz&KltGz!U$eRo=q7yrK9`;I9&X`+k_d0K8rL>j2SZ;NGsGYx7ti zGwG1*z4x%MHHVa;DF*Lhm(!E3g+5tp?fvCd4}Nk{;oa9S(4+PJe;qmzFUZYa?fVM+ z#@{&P&;%THnk?KBxU6HM=B*p@!ql`$nTn8$Fx89xu{7|Xa))&lgb^3!n|I5eLH_NJ z+kcbNuxF2>Cz~K&zFdwi4o1LP%AYiCd=bB#QdW$>ymJ)>-pCt6+;#Qa$8h++Mxyh7 zt57$*^^D!y*%to6<47RUyWhmmcYI43#}zuRKPV3dnGk;A6Z zj<72sLw#R9Sxh@E@Zpirp;u>>!*jShPnHzq+sbF93%ect(Aw5&BkBD=n9bey#?0 zk^=vHNZq(X3p4m6H3qHYm(xN~z@N{4FArzpIx|_GTsGh{ z&wHh3uE0Ndw&@36xQF>Y(XKas3w3=|VGVLl82>`o*qAl=z(*-U1YY3mOM1o%_@|%x zOs%BO@OKrQF~=T5?%wP^@_dQ9k3m2Czo+1qP5g>viqEl_@ebRlh$+K9p0{p zhtMAf3zlGQ;HsM!vJSV z@M5MUeds#k)k3wrGR*TsQ==p<;DtjEtnxC}ATJy&eh07)RVFnNG{f+V`^HY(>B6|R zHq{)y;J&>y{|N6f%=+nc>2w?PM7C7NqX%)(5%R}rSV!ac5@E+6N5ih=dlRRCr#*fe z66&)2ZqdvrV?Ec--*CAJ{z%zl`-BhhQ>(?rmJF;{OiogFj5yYlR4?8V?VS-b$qMj0 z3jR*ErNBooRLkpV!AsqcIxemYT=n;JBjbt%@@e6(uISmLPV1&^+Yd+ZS#O=HOb`b! z&lNOZ1@8K3%9=f{iv1UKyz`6T$%wv^R*-|o3XYPWo`zgG4ayvT3i;4qHPPD#K8w`X z;9CdUwUht#zG1}v#+z-70*Eu#F7w(90QY!sK2iD&yl*``BXOL7$E@?D)lionB3AwS zE5;K*^}(BP?nHHW&QD+9C~BWqTV&wb{;2+CB-AUuwf-@YWr{kp@Fs88E68h721<%S z&z2@aJ=-u3`>w=gGI0Z6Ry{a1iTj>v)w^=<0P4i1uU)ywgmW&=39TEWUwmtpTBPVl z`OrT~N6c^0-G7^e_xo6Q6es>}04{2O99i%d`9K-N)0=6Kn;+|*F)@f&Z5EdnpqJ0b z9*0wUVtve#Dh~q>JY`}ezk3z&LVv7af)4WW)QxJdw86u2hgB`9!~cqYA?Y}e`;K|E zM8l4hQjFczR09vH;QE13|3o4#z*G)D9UJ{lL;<+XsMC9O(jM`|MKT}L>#+Mvc7~&t zz-I-LQ$O&(a}NqHG2ywx3Ja1Ru86aH?au2#fBf$hCYtzzS3PIn%#Ai(b4XF!9rnJ? z(MAgXgIPK7==-z4Gw!QDHQ4d}s0@Y54(d^xMe+j?p9WT1{QLp`7^>!0P*DXO5Po)V zM}`O+p{y_f4R_j2&~F71UMmVWTcUlD#JjB0lyiWL6*UVov`G1%Mp?T1n^9}7zcwHIz6 z&z|>5pgtaXDaW1Ge&}&%d=7V59PElrt-v?f1B!d`w{}D@-n^+hSK)`kTgfSnfb&%P zd%vb9qyFl(Zn}*-_BXL`w!PIv-T0d7-@Wj=+{=Egax^&qTIk~u>s3ej^P{p7bMViS zp|yTgD~|G>Au*xGbc8yT<=-LF@OKL?#-HGy7j9ceivbrMWqHN;2LA5D;S`oSJpaq9H|D*T5!Fc?(d8Ezk)l;*$4GVqD+E=z)iIuhM69`#{07~TFW}# z5zfQvbL7PJweQG#z7*j-D1GIPEYIQB_LBTf#&vwbQv%e$Y5Sb@Ej=AjU;d!7bQQeL zW=s+{`!nndl(f;=Q;c(z))Mk*$G{tD(;qps7xq>qG0#L4I9xqUEnW`!izA~&1HixD zWbt}__Z96~2c)jRzhAuT^Nt;La!0Bz^-Ma-e;9nPKN*QYve{g zYL^1%KUmbzdIo#Z#_Yyw0Q@aR>>dv}PXUW)sx$OCUu^Y_yNA5=PtB%q&}FX~5zp+AWVD?B$&ARf8)L#Yn-aU!g~%^3ENl%uPN47lR% zRZgvI&B%xCBu-1Bo|kv-Hh&!WDh1kNA7%I}^K)c529Hr!yy9HA;0OLe;e6sf_=Oy% zbNhuEaISWV!-{qj@WqpZo(7@decEf^y25TRHaLB}jCfV8eur2I{7}UcTKlqa@cV;p zGZW8|cPeyRRL44Bae3qPxB>fY;&@bN;ipxZ#x@PxJSTK=!+dPzS;|1fB5}+d=~sp@YmCBk-!O&MITcrrq|%{>(+u+fSY3MRW$bDxnJp$25n)tDUXQdP{(5ZmY;`wN57BiPB8c2 zx)}?a{Jn*+m)^E!L73OI=(dk?@&@o=z!k9zzrgQ#TWU~$L%qoPh89lXD_Pq+=5Nt%Q)Mc3;`?U| z7JG(&f`<#KG>n*o|M$wd7tEA!@kNfoh%b?F9gSxE!O+_X+8U}rF0TyK6d@Y^jPrH5PsfHYA)aaeK zgy$Ss4`E^E$8+9^Y|bA8eo{&PV~#rd?%pXX4zwBb8y!Z#Hy$lDp+Tri|2k@R>-rHFY1{=VW$*P8D zhQVu5H*awh;t8!?@z`(Z-zewlooo(g`5(lwK`p>pdK3pE3UReTZu7w6f{T$IFO41a2U zjElwq^QrfP;A1W1Ge=h%wl!c^%fUIrdeG%0sy|rZ`_=!5C7s52T&HDwTYaHZNe*i# z;yCX`wRq1KdEsbq*DrbSSPti!|6z<%cw~GL+!ME+|L`~J8LE_nbNez;$N2AXo&7WP z$x4tdo5$?zb3prb4X>rFQ=LSTpu^A`nJ8tU9`!TUJp}Ro1eb|hvL=GBv?_1e)xyt?Q}oh2LSCC2=vryfjXtiLt4=+L2aLU6CwA(GsiyqA zefXX6o*UEW{4w57hSm(Y-UqI)^fSW`rv0^|a>Vt>|B!XtnHTf?5b@&75_lx2&4%_f z^6Vq>ho$1tcl5Bsh0PuMNS3(9@>TG|ueg=AbKn~98;^f*pl^i!8H3jztQ)*7<9~FW zNSNpxqpsM7ev(^#ruZQCeQFA`nvp=w{d- zIhW23Jjd_-kLP8-H{NH;=%_ZTj0WMH3h$9l}VuzPLM-d6q{9T6_p5nFH<@=}bIhO~HoOeoy1iIJm zHeWi4go8i2$M(z;2@?A}q>N~H`t>J1@t=f!t%!Y|ZVb4&o8bC5Pwsx;41Kmb zQlu^nI#aN4jmSIn-J2A*@!-B(Sw8n(axdbQc~U{~Md-<^UVDTdK=*#w`o$CRC2t}n z@xxwn0%|4}sP^W!aW4^Qr~v$WvQtf%{oy6a)@8Jyi#;3;}L_OMGa zsDnOU5_ug0P8pNh<>rfeFl$xVGcVNlBv?orz{wKh6&G~yI$B{od@BL@&Z4l-80;^| zNNA`5oFX{OtXzw@s8MOHV+Q{cqj@7gmlizomPTY4+$>7YRB@&TdhFAJy&SmTh1rG2 z?4n>dG^$NJj;Q^8y%34z#|-{9#wp+M5hLnC!iW8_vt^zIJ~fIPMf@hZ-ArOF2@}yaHUv zc;&R!7!~r-4VySCZtw~tW$~Y*u&4S*yFVO<9&~{F$q8BbDT#7rQA^Y{tZTLM!B?b? z!Y(Hoz%lvEdh3X<8QJ`a2B=$*Zr53({?LP7d@4}1g`OlQ*>X|Hj&Mhn zTzKFI`b#T5OI2(ujJ{(_I7NDbOpDETx~$BVNfKeZc!%-Hx!^?vlt} z@Kxx{y#FDbhkJ?itkqZ83rAU81vu&i{k?a$qEYA2bjr4Uig8=;2vEL3pVfErcZvn5 z&-vt^Yr*k}r+-l~>~GU>q;c9VvOtN5VHknI23F%Ir2 z(QA-@3_a#b$f$qB27b3#c!A(ga8vDYK=>D&N3)pUqy^(Wu&XDz4SE}2yO8_<@*nz@ zFqtV_mt1uzlU3+v#?BX75$_ZI1s&-ru%CKa?x96+fL!F*N)Nbzlqe)E0G%iFykbO( zIQV2;yg&~;b@NhY`3Q8Lk&4E?=455>i^E<_3tsV%DYPm=e2i|%kbnvt(IE-eW6pMql9ihD9i~BzC zo5OqROz%_RsM#08*YNtHCsT7W>W<6*7DM~N?bU%SOatI0mePt!MhW!UA3Biw3*$Vp z7^<8DKC{?rStMKp|D+tqu>;q?qH?yo29C~I9ihrc zfbH!))IrlFj4D0QhxMsBlv~WLfXd;&bIv!$Eh=pl7kXG!njo{o}5% ziVP`&8wV$@%VInvo)&9#;L*O%*{!YMyiDe^cb`IMqn9`MV2*ja$gb*T2A*Bb9cjy* zhR(m%ZNCZqF{H$Tap$?S0okV`b3P-kXcm=yhh6;PwGP;M&aFawdDGbd)W1eqL~QRN zuTW2$5`i7R(zNG2~5oJ5(~?Bbz-I-NYd7K=FMrR}(GAL6ma-}?5L)9@o! z?Rq=@+w(8gMl$SNHa<*mhu1!2@99ppfL;^6{fr*=u2lPl?iKQlS&^z4A-unESfcI9 zIeZ`g>g_IYli%H78D0~7zNfCR#trq$-E~^~;4f%Wqn?vEz}|DzBx>M~CH|xxJoz8` zO`?yGcp%RIu253)MP6DPL{9T82=$xZK!J59)ccy3!{~8bc=zY{S;S|W4YtyL13t^;k=lNPcv!Zn(5Zradgwjpp?btGXW75xO^8pg zMosExED;AJ{^{RCzCK;ZNtewB{U-dse~j$d_j->8OUF^v>CEcBv!2H9R1p5Crvc8H zP2gEV9J(h|t8x=@kvFCLaonH{p=#4!t{MDvMwHPai3j>~j@W~4aLK%bKFKb`4gJ;r zqbjV(r|wl9Zo+kr5a=w3!{4n}l$)xK;J)W_gjF)bo}5SKP9g3{wKz|7EkNh$aOjo( zf_`F^k>d{Ftv6?`uDU|ccwT2*5DK2+oOu5xv;*~sr|t-9YP5n`2Bf;O+22S;Kf4O+b6*h5`|v(ld`by>FXa|cDVk= zO%txv|G-6^nVXmPgX0f0##U1z4wAg>i(ZD_K|3sj{=qaO$bL z!wSYt^VsI9#VGjO^m9BJIMf~eap1&q#Sdbm`wA_cG2f?>|?Ypxwz_l4(!p*P2 zLC(un?mse!gh?7PhMY(up>=G+vo#R)Le4(+!5|{R^!tS|{V*cI!k_9UI^YSxf?~-9 zIJOa|o2tNBre_c8gn+*!v%9?M(}{#1Cavf1fY(&-W{f7)5D7l7`i@8U<9iam_G-@& z2}{x4|ILu2UU(=z<-#HGXs`sk@Nv{vRd2@Vih{H1C*;4vK4dIJr&jKQ!)fP5_h#ez zyV8xt&f)r8>W@wace4I?+mv%1`qApwl$VdO9?H?BjRx_VJ)H=2(}p zt=wx*mF!6?kz#RTbPdG9PDL4hVGK66TVmX$P-_1 z)*s`f3Yp8;XPuggvi=76sbNce$qjt;ktDkf{FL@z-1uM2gN{q@j`d}rf9r+JA%mB& z!+vEy(@=2XIAstIj#HUNyqCdYdckx5E#dp$Nf7oM?gFGOY)XA^$6z24z2Qjd_gRM5F@#`|qARv`a0-M2XG2fb$LV)EZx&{e9-LwVpI z7vyT()2-0YVeaOb>jZskuTyQ3E9z{P8Fo9*5lA>`lK%V=@>GJur}1#qr)J&zTfr~2 z2iFbufCm!iZ|bi6!FdVmz8tjJH%N0{JQ#dMJ3*$#gZOs!zkB{cn&7|pE?IntpJmsY zR&Ro*hA9JlUMe6yJx*)d=^rM!9&S#LI*_qK&3e-k>R!_NGIu*rzpy>M8uSkRkiz5l zJ78C#4!mR!z$?ei#$A#Uk&niT6s4!b?`6!yd`<&Tv5pjtBtSoJzZU5XF03OVBj<-* z?sjIf62|Z1GP3vGZ;R`p{+^zmi1>9~!u}69)8ZUw=u0s4sHM`OXTc)DBN&A z44vgJ?$k^B%ve2UYH{B#nWTw!BcJV=piP@X{AhP%u>OnwJuNW>2`cm%EglrPg?g6u z!|soH(0^1Isah1l^Kfz|5>^Sgf3h#)jKEdLY;Ks{y#>yT2#idJ&Lg|c ze%Tt_@r`@eoih%01aStH_dE6JCcW~dbZN(8TkK*FKoTw}@kEU=dyKOzIHH}+6uehd$Yh2(Iqyy8Pxd?C zCr?*(Cj|RI_|S^@VjRJ|oMl2`(9_g-`IGSX-iVQXf={4N-Fr0oDG0hN->zX+Z`3Cb zb~#VEU>u8|DyhMb!G4yheBi=Zzf01$@%?PKyE80hp^yD+ejX=)I_S}qM~7JK2!F>0 zwS1}3mo`G-%?gfP`_x+@vKyS&o?rUkHaO%~d42r~=JR*EOESM;#}{q)?%b~no7Q=P zAHn0#?S|-)U%W^(r~CqY&t^D69EANFoE3O50(;V>=3=n}*Ypfq9SX$!Jz|}FVvi~G z4ZF)1WL03Nj9T8BGVqH>OPearAX0LhXG=#$f;Tod<`T!D}uW zq34Kry+8gxwVmg7490SOpV;~Q1WnRSa9T{v@A`pL(7CoF(zz62M|63*>)^59Y;}w~ zpC?@FUuVTUa-*^vE>_#AFV-|%ISxOT^y9WT{BYCt#YYYAp^qrK_awrfntsy`;=77` zUp}h*upYR=vGKQ8FO&Om_~0$ z)L-;*9GCuem>jwlwV6 z3td4y{>;iGbTszh0>4h=?XNVmjq&}1lOI(L5f9?u$S?apLjO0lc4gKz#8aL_i~FFf za9UXg(Wu)H{(Yk5)iy@onEi>17aWj}E2=i}gGV}I_5L>IgAX=SS{nNiZ`ABpB{!hU zr8~(GX;G&<@=BQwyp*TQSVu&B%e0c5ym=V)U)2W==^W6rlB$2T@}n=HOFn0(uRr?W zK`MF)^jo+pQ0(mMe7?W)%p-Qx=ji#)a*!ZT-Dk1O}U<`%wqiU80Khx?MBw-@I#S!Y^Dmn{I;KEOZRBj<#)l?6u>W!Ius{3^thy+f}BN}qOM8dPKR?9W? zcX`LxZw`XLR&3dv%_+g1Tea73iJ*_~o5#&Z7U0y3>in1_aMz^`?pkoXf8cQHCOOu1 zO|Mn@;rr`L;r8apO&5H8A$5(U;Tji^wD&8k-rxF#&uJto#zkQ-nl&gmk#sz zkJbV98PqR7Uo;nmZu~d>rQHwQxBeIBkICM~`V4h>y4rKFx0L6n1%$9pW4V6wJ?5Lm z-&=~j&;v*K!)5%M!2b&)CCjk;3fc3vT9_}Mm-uh#fa`hI!!Lb7zC!i#$YWRB&;7%Z zvA zU2%VpdJ7KpH;50unhtLA_kIUM_OP35HS!vANQ zw0mE{PTH9K&M+^56OD$YlQ;4G|LEUEfzzXOXlD znuPrUS3M%FKL-8fkpY?D-dyw@kl5d0e2INS9Lxljz$^ceQoDWxH*Ft2etmtf~s4t|6Wr z)fjsx3A?`aESP!$=iz8v<4Jx1UW$$p-9)_0TB#{}5(IA5>^v#(1nc%LktmagqAro` zYbFG~^579)2t=HGHy2|*{TjN0L`BJ3HSG5Rr`yID_MecNxz#{|=P&=*rsY6{jlQy`Ks34i&ufOltK(<~7ni|PzUp#1Y8B8i;-0sigcZ9h&VZ{Z?6hu)x z`saBJI7hpxhLi?+qy8Pu)1J_&Vs1E|U9$z}?Xvr*0nS=2k!qU2>yMAi@*Y6%*%K=$ zek2sSWJ2Mn&r3VP+b`k$jY;6`7cPCX(Re+@lK<5M>n_4{ed&lh+%2x04t*(Wi?((E z9Cbn>o>Ub4^es+Ky9it}b+Lj~4cwN+lDt;ug}%Ns?%GNCd~Z9!O3B%dAT@uW+7sjW z!r*#D8pq2X$HemRIq4WbHiO5|k0hu^?}78kzK-j-C4+BRWA2{JKtEvS?9rJw$Vc2* z$SM=<2qtPbchSdU{E=~cFN3c{63fO0@Oy?e_$cyWIr`|vZ+qSmI2iNP=J8T(&_h~ic0z+WOj`pd66|mcfA2$lFYNM{*X^NzHz=i2XlA(`45u%Gtt*8k3;FVAdL zfL93mC|P)6-bwTWUW-(}D~|b4M;lZl2Yuvi6p1YS{!n*Uv@5ucWp|&wKR!R%Bv%+O zfP8G!Kky~|9PtU+*ZDle!{_sN(%ryAe4a%`;3|XSi^J-Q=(ipW9`=BLkIOP&>XJcU zl29l|oiOrfw~C0L$MAo4<*H3iq4sQ`h{R9Qo!t(COib!OZ+|Qu1dtQ3D4@0YDx4hqzQ`>xS@xgEfT!P zfO);q#Cile3&V6$^bF3we>zjC6>+8hLL?inE5^tl8ipirw9uLkr^o{ZN$Nd|I?$E+9HG{ZH|M6$EPBF$gl$Tfb-t{crbIR0(#0o)p1XJj!khWX22i&9t5x#r}^OfLXO4sL7y;9n`Gbs4_GLK z2kz{Xs%Ka1Oz*l=Cmsy4HG$6c;X%T*0`#;Dw!prV;5PsCLT*~{^Tl6ef6#YT&^b6p zSpgop8|uptLnJ7896xyYA(4=v+kaExF8Z$~RK%$4iG)g8W-B2_B4N%mMc}d<5z_as zwygWmv8ZV_%Uy{C#vAl~6L#o#|FqEa*OEwZN^?IdL?jYs$LII`htJ*oPyhg9{ zE__cgk&u1Lr&=zSNMP0ReK-cL<2$c-N8=rl(BCx9T~tjZ2vK#1^`LKFUTDDh4F&eo z(u|n(Is<;a7Hn#N6Lx8vCH4^4qn(aBbK)(ywC-T^&U0oiifo@JCx@Nxoqwn=i1^%f zm0VE;ys!`-;b{Qr+H;n$(S_Ze?zCHB! zAFgu%-&kAf=3ojPQk=)h{TcSZFf@Ls)PX!@yiMpN z<}uwl5s{a$o8di776&nJ7AX8r7l2=?rz+!w7g7HooVpnTyXB~#JL=aCed^V~TTR$O zd({dJwJ-K1`M#T|3f(SuLylt`_jCE9yeLT^@{c_{flQd6gAcZMSHiyTj}6Z#Cd1zB zU879qGq=Hai@rY`$0m02fe5#J z9KYMVY)^--mtL2qQUbopX0#Q#jqBC35T#h-i`UFYellmlpYjDU)^(!)!LPYpY8|?r zN9Ls`Oz_)IrsfSa@Y_@iw>}J`PHVa9C7g-4Ph#OG9=NlArZJDE8|tS?>my9|@OOKw z8Lxm39*Fzci<(1s{`0-{y*2VrpB6Q1Tima7@?u6J>V;Q0!|m}pDU9=N;X}+r@%A?r z;Fp!r8p)mp-^%EhN`%HYF_++3ahIK-XBG*@Sg^UW4@;a=RQgS%p@S@HWB zrW1xdhEU(3Bhk`aLI2>&TNR33;F`CMOUm2O|HD4^CoDowTNE^l`T>2Bd(z}Q>|x}t zqS*!T*_ES=ni56O;aYTwHw(el9z4%FYjB@bY-b*U%SS`l*iM1l61qyfUbCTJ&b-WF zNyv`y=-ISdH+01I&&-K3IG)+2kKq9?5dGT9;=xz>1}rTR`aAp8*6YrIgSw&^|H}hk z2=*&pK5q=&>%incM-%8oZPHnm(6iK*;)~4#pm$B%DS0QL52@y~GClZ;>CeSD!6?)l zbp&*(z(@CE>K-{kUrPFVZ10jao|kN@8zY6!o6VFpbwLmNa%!zHF%o^_hlaK5p?^)C z_6nH<2hk;jQ6GB&orxj(f&=uYr{h5P=;vzV zNpr}wBRnvCRc>F5aUa^Zmr#j(B{KBeB!o92oN z9)QDayJd<*kbf^Dnw$^~+9Qf+OzK>%ew8%fgg`c=UkGx&&J!(D+J(k!$e)X?jUct^pQq}%M5)5D~4wazz420JrQTrVFzhZ+7;lejP>yxW;OIYF+6zf;2Y9Y3yC0{-ctaNYckI8(U2`uHHYmbF(j48P~{=C$9gx1jGmV&tpw zN4_Um{wo50BtRrRr7-|`jK|%xHym-F-HDe(;jcS{&JXR>W3TlT-1xe(^ZR^+=%L3n z%l&Q^Mx5I1vi!zGx(Q@A-oMdC_Yp&yHX{TAGfP$+w-p zse5}y2hnE|?y@yE0RGsM!f_CB%dCGu^)@)}+GzVXl?^;+dQ4_X4DqdHF)Vu*GxBBo zfX{;>sQcQ82-sbO-r4^B5fkp~{ogOM%J5o3@IO^%+)tnDGK$X*qtAe^*MbM0_OHSqWK_v%XJ;6i>$qOp&qYQ{hu1@OCv7Z34~XHufO(j2Ubzy{*L6g z=&TS4cP5wBI)4%g(|td@9XrrxRe091wtz@b5?%RxAeu<{J@-9k&4oxf(cwayWJV<9 zJoxdN#*j$x5)jRi(IpaWE=Ml=>!1%yS($Q54?0!C??FogysziL>neTpw|fT)yJ~`~ zdTh6Al!*k2fp;Meszkz?e0a3nWz-FSHig+4fxogn3Tti=2^@Caq%AhktzH@)yx>eE z2x5bVXOF;FCg>x4MkM?(javuum&Hs^0}72L|e_L1%Y_?vQAAmPk9=7VWZ?4c8gKeW>%YnZIHamTg z+Nm8L=uZ)U$*m5(;O~B^RXf~&#W~UBc~aC<_@@5EVIJPSIdwhQ3LM{c;foakc}SXg zuZ9$Kpj$#msM%lcaTd+0OI zW$B#Y5Bk_gVtbv@$NK8(#Uv;2)q$jMv+xHt%B+K);0Nm$JW>?kC*P&-UfMV=^llXM zTB9D3&R*~WetFL98_!OCjMDBaWt}J1t-U##HUod&{L{-mMf$FNU?oPp#sX6Oav>t$--s@WEW;8*zkcOJ&^UAgd2 zuZ1b6o?@NgBRe$*a9n-spyXS8znv}H=BO5Qwd7(&Vfbx_23nH^ef0eb_BaaN2EY6( zm#4T3eTeO=m>;-nPs^mKNhtDto={55B%LZQ z;g}>S`MmErxM!T#O8OQ0_?Az&AC1OQO@3wuTt~0*T=te8`l9$Y-mW9AsBoKC4lrW9 z)LzoJJT&M(X?RdT%?5w!BfDY;?y87*lGUOMeNZ)z+XdINNLj?~KX4pn>W3$a;3}>g z3H@cSp#xg6?k|6fzNjZtJy!3~k2fVjl2`(MJZYHlrx|>i?P;|B6YJvNDQeiQ;yO5d zHfY>H9cCZR-pK{zouc<5>c$Y~X5EryyWuyjvmJKTqb}5Y$NO3(c+y{Zx#CobSTD%AzI2bN|~T_ft^^6!}}K^ZTG6t9{2i-sqw}S1HJ1V}W(8 z!jcW_KG;Xg-1u5Z9G?HYaeP7)Jalin*}xigxn5}+250cl*OJ)?k%y?;`MdRzc%m=7 z&zk7$5B_nG6!(Vyb@~e{Wzc)@R-VG^ssiY2zQ&7=;G?vbKR$~1dsM!UNFlh*=y-kp z^%y&XqIkO3TC^R3t8uz2?Hp${y59tmy9+uRZ_V$jld9m(zsVP`%i{XotRK=q z{*d`$Bfa)G>VhdI9Lw}rZ}@imfx_AjuiJ1nO=2H|W0K1O)9ABOImcdr``9m&`05Sx zs&T=Gz6YRR6^=3*iQ@Isq0c8`XE5Js?Pruap+B6TWcX15{}@Jby$<%#8bR+V1v_RT zF4Wp0Z;1L3;CD71T+=2crw))3D>U8!w-BMS{=%Niv5Zk9eqd+Sk|_-^fLwtG_R7zW5;?zpuX3Sac8l%3EARbsFf0oj5GA!&O(vgFCPCpf2{r zv@MqjeN6GWih_I5*E2*e+e?aga5_}>=OU4Cmm{zKSr6i>-FQww5s@%sI-M1XzL;1u z_ERZ1nv+DI6U-wL$WBSAh}UDi{q$li=_HZxRqAc_sl)L9-BJvp#?XP3N*Q{=2_{3e zO55|;pFQm7@M%uy-7Z@-Qkv*{XLxe-g%AAdjGdGj{HhLfk?hX?#D&JhGoqMhjQWKS zjgz4d&X=9}0{=sxd7UT--A;+m(eEYv#2>$X4m;0{Yhk*S9GC~a<`3VYb$nk^t@J<5 zO7xMKHYhaqA|JQDCFwMUK4|+|=}wFzNYhLA$t-lW7OqYHU+6Q*O|yOT9q~d!R@CAr z`pWb&JN0Lfzb}l6h~c`r+?u}g5pgX$?6T+)a_I0reKyHQpzqIeZ+#Jif2>-X<~a|& z!LjM{Jp$?)`#st?&%oZwb{$f|@0E~MZ#j$j=p&lb=YqHto$`WXxg7Oen%r^YRD9o- zE|c+d)G4`Vysg1c$Ir!`?ZEF4y|UFjnG3FJeD3a=4c%)adZqwJW@A6)s3OEyx$U|v z#Jx)Tl+`PxsPnMZW=AgR1JJRIcob;7WbdD;#19Ee(ZZh) zLwK7S8lAv^czo>Okjo~KU}@2o%RN9OTxMuFCILQiF1~D4mxA?v@+@l9;3)mu_b1c+ zz%Tjhg&GdvEael;rPshkpz{Kfs6l4rvddf7KxtwiWy^E8dE2KuT#rGc<8_ETWaxJ#x5p7CTnD(Vb9$wX?Y z3VciPYExMgb~Cug`g{Nt@~5YPhqZA(+cob@Ttr-qyc!etA{hEArJ#O0{K2~L@6={{ z*eCPn%A=U4P9MqXPr)wNMHc!(p#wG5U%8=Y4m;~S%y{E6xUFz4rbP#OR$@#?qraK>c7R}O;@gC?~qLI(m#<9PZhggitF#0SFGEVR5#{Qz^ zY~~u^_1M7RcK$x-kSC*Q20nnBwraRGU{`al$_%Wr;QFaErhkLMYy5Q~VcyWk=F-+& zJ+ZHZfK9t}Aoj~LZ%!&eUQ&`k!O{*sBMbA9eDfN81Yx)7Xkdq=8#Fw*uvgckHHmX= z=+kUj$eBl@J51YT)PLqAe2U@AuaW5h;yjdUOCB}V(htq&spSw?(4 z34O$0PhFyq5q(+88zsJY-zWPYNk_p27pIIRRuMl2nk`dP!5tT8E;LKQKgG8^?o7FX zIt4lFd0kwG+HNixKT+`2U^XY+$%KYJsNbh_=9D24wDRhJj%B-yENe>h=J z2m5A8^s?f^-^-Qe$uaH#R)?WjjOTORRE7Y!)S`^{@ms_{<#oTck{u!E$CI_t<+hos9&xw z5sy#7PRc6Dn+Bkp-MGcc)Q0+_v1eR*1N{FxJ2|UH>>rc$RJ!mB`oO-8O^YIaU#q$> z`3!a3U;EjL)WA=D;)flV@Ysm$z83T+*_8EC4%FplqV6uT z#$w%QspEnBJ33Nw+czWdRschbKP`Ajayq5*1O6|?HJXzKT`C|fbkzkq)9GZgSFgZ3 z6Na5+OpT}?sw)RyZNT~G=--spV|`yUIn!I{Pj3XI&#>QwBnKsuPw_Zs!U z=qI`yx#;f`7tC3!M*VVEF`={*{b0UsD!c>WnkN_CnYy8~@;6Kie!~6}7M&_is1weR zJD<<?1nxjd4jCN9{K6RfXVw0c)2CoG09^c z9Fr7s%J4VrD{}RRJnq+h7Hf7##P0^q{))cL9i3sB`Q|g&tyE#Q1MGHg>+^{?*!ArC z8bqvMHxz)KpBFIt_s0B)KexU?yS z^TnC9s0(Ag?1~C)4G;WOKyJt&j@yCTPkco%Z?&z9*1%^syd^0Dd693lSyig8!hfo0 zZHks)y-=V@Mg{z+ztkn#qq?a3N&c-f7sEQh{&y3hT=0`xZ@DMISC8b)H-AtguWc(l zCBFxL_pPq~)&`Mq%!l@s>o+1{dBonfst|GY+J_Nl^u_didR-xn_@&Th-(&{8BGu~v zbrAZP^L{urQ-i~}kGh>z1g9w+tPuNo3%pR0PMGY%z7E$0Mpn7OADovBL$u(RbdQr# zy2Jlf7*Y9Wz~AbV28>~TMYnowYaovm(BaTJ*9s2n@=!XD|NpG5k#zBb|DEq8Q0sxm zG} z+Z_-MPP%Y$sM-m-K#^#S>VG&M@}KryL7Zq%q1iV#iS>!O?pFnVKnH3|6FE76>pK3m zbR6;apvFP=c>I4di+)6$68Wq9mqAtz>{k1);oRf z9w+LGjGnU3s8ILlo*McN&U>!2XVktP{lbrI!nHHNJ-5x3O5-qYYdW#YXV}-WwS%X8F;NU8DEepiCs}C5~_9E_zD%rP(;65Mk6~5>P{#u=Hn!bd(PrQnq%NV#y zj?49P9^!bgzA1-<5cDs}PggtkA+Fb*U`?HeUX-w5R)+dsb&>1*Fz)lNc;CmLo3YPA z^s>is?3eIgx=N8B`k_n~ZYnf85eXsWYeqk>V?QhYQ*jpBM8b_l1;$+Y+t;l;gk#GV z)h>1sBB7&sK3$1`ek{f(hE?FEXsV1$H5x=hcuk|z?Vd|!>H<9*{M zB#bY>WzSNzPmzGfyuAWXMBsD5cmIpE$2k9W#l+@&g2SF?9wmFTQ^yoZ9&IHOludg2 z4=fW2wX|3EQnI3s%qE-LML=D!KHA630)23WWYoK&pmPn|tWWi7FgvtQy z*I^*BIRu?Dw>+^!9rt^${pS+CBJ?9#`#04VKwk<~pihL|Yrf4a`vf~}xWlHq1@7|c zzgT?^WTgch2fpC>M&7Qke!-4wcUwgq-G%zi`jt$N z6VO@GA6im@YvPj5^iIA22g$vEw9$!tv8nd}9rEG?fr%|@)EB5Jll)~U&`10#`QM>A z=z-Gxzp@aQ?`4xTH$B0;FU!bUvP8XXLA6ra2=nVl+GOrk=-x%ivWD=hLgNBow=bj4 zbmG*s1&(i?UsL!GenGNcAmyJfbQft$qd)ra;}RtED&R3P`iWd_aL4Hrk$b}t_czIF zV~xmBXL``+VM2#E(=&UmoEq`RlxpcTUW;y$t86eJ{_Zty&84)%bN9@~|13bKS^B}k z+JidnTfV>Vz!zlf!JkLtFn)W7sd)Iaq0MiXxG~(b5 zOP3w7L;dXi?`t(q(4z*&mkq&NS--UQ$fu&7ZEiM7i#TTERY&F%1OK^^8$s!S_@c%{ zO0NX_bT*T?4?p$dae(?+GQ_QIj@Y72)R#R*W6#1bm51#=u88r?8~yPukwd-Ia=yFg zCb;gm6Z3EQU6uX*&W97Bi&fLI<`yFF<)JMVtbqTWbLuZIKppdF%G1v|;4OCZqvfTj zlh^HgCDskStH*Ea)-3olOZoT^;<1DbZ|(RB#!*0N&^Cp7#CV-}0Q~)A|8T_XUR*zi zG~zU_??DfLZS_8Ue*5cO(+G62{zv&G<=sgYBXbYfA@dVYWhk=u#oO2?6 zDWH$Lbt3*VIBUN=TiFQy&nEV9-BSg2c9fDz3h$E&dRiESDt-jI)xyE%Oe(=i^KESo}T>4!<7>;LQ&0uhrL} z$G&T~b9;LfdRWMYkOw>V$yh1&o<#m|U!y&m19mPd`>j78_sOTdJM-^_mL9?6R^|$#;@7%`r~$a=lL!i_x`xg48F=3 z7*6tejlT7h=W^09ufrQJ=$Uy!pNyq{v4HtPuSu3pd1+hYHmqaJtEj4>anPtC-`9}{17rta(ub?{_~ z*d1x;!_7`zGh*-u=NKZS&wvA$PkA|jt0W@5K8#49-ZZ!BfB!W2o~PTlUIhJ-T&=Gs z1d;!py(f4TuiX@S{hh_3qwS$4=Yn6m6ta7p7ktI#ux%^|KPWz%Ycd~-{+-147t1W+ zAFF1St}3CQis^f$jwsgMxs&Kb97A56KC#ls0bR?)R*eEjwO+^LhAhzg=l8SdQa~5c zburnCzG2UpxKYM@BB6_{w96?BIsnPj)-&jbSrz{3$_qV1(cr1t1osz%rppI170 zHHjRYV14xV7d;l_iA^z|I*G_rk|N4QaQ(Rcyl#KT=N0rk&z=|VbZT(5cIr?r~U3-6ydPRH*KqV>INvIVY4w!1ts zhgq!_%HY)+L`JG{?EV}YT43(eI-4owd=}IPc$~Y*U#X(^au~beH44g-00*p?`_{^#G?l>T6Pk_PZOs&{wq>Fl}y4 zBy5!4e$tLQU%h4Z^=#-$P3&*|>cofy_0lh%8T`BO}#)Q_y$b!@alud z4n9@YyN>$fGGk1qDUqO4H}usR^})Yy3dC>X|ITIQJPhEx$}8#(FP2;&4?cR= zyFTjp;N}ZP0&NWw68=< zyB9npucSM`jQjqp$)}1O_MtncU(Z;D{;J}^iQyj9h1s-6TRLG^-#&dm3=T`_ktQDl zuYIhIz5O5Zo>xm{cY<+#F54rzk&lpnv1Ohr&qE)TJNLyU*tf|WrHaWW@IFJMmwh$% z)8c%6YytUz31joH{4nw{RSmAf<(=nCM&?Y@qfdGvaoQEvh0~wnHp6}B>fb&NQk`1plmE*I3tz`rDVgR}8pW(LY;2LbCym$vY%f+67(WjDz$Ap>pI~9piovLlCFi zNt_qKMOXeMwRIap-%8@E=2k_W_9)Nj7hGrdo`D<2;FLrC@^liSsB7_6{%euM^U%_$ zo?RuNZ?bdi)-Al>fSW_34qRfJwV0-yjXt7lLEA5p zB7dJMlz(Ud?mEW6`Lz_s>{0e8$A8dc4n;h8fzM6X>escyUqw0oE_e&RD4wBsl#`A) zaYNUq2;=5Xma`nUM1MQ^w9%{rILpC7_b2@L@q?R#tnl}dp;X?+7^l7&+nhZ3YLGv1 zubndLFNW!4=hflQZrRURlpNf7PLI)zM}fPN5qIR#-`sg=XA>*nygd1MdLFQRU`;B{mV{E!Z#0QdYR z^2u-Ik`%B{-Haoq-q5qAguD4Uc%e6N^-5k*LmW!aqd$b}uWLMU@=PFf#xJ!k1bol; z$|=82oAL z1TCZQt9$p8P;lyN->L@cU*M|P(EDECr%O}}adN}p&C`jB4-vo5@cLMV;Fzj%Hs|mJ zu4i4}fg`)X!{3*dCHTP^ztT!Ol&~MW*=YMQaKs(WDz-cg^kaoIz7z*Pt-AUg)Yrm3 z3CmWq**Mm4>&gkJVgG|DVJAA&$+SK{>Fw3Qk?UT_;w^C1*}Z82uBi7#=hA$DZZ#Nw z*mEEHre>L}y%L~T*{L%rQbC_exbURG16(DQaN*Jp7tyzMJeGhi6%w7k{h<$iVE2_J zCcdM;DqLpk{x{fBsn+H1L-^dsrn+@-)^>WE%suE%DW|91_O*ed*6vKiL7!Su>9r9l zM*o!ULZTgxbT>T37@ur+E?e1$CTH+KPU(eYz>gw%Z=Yd>+@X^d^%HM%BacbSHp_=yu=Ts$D1463)0q0nKf=7_E#bfI z0B&2LKksP^J}){SejaiCl|fk^6YMtEOZ;IP@&g9)uHdLR)c+#VDo^Q@uH)ZnX) zAFh+P@j2F}lV4}9p#FU2_+fp_vrgK2vMu-@pM;L7GvZh;(x}7CFNFNJv_jEZ0C9LR zI+=qX^X}adm8X2@FZ{Q?-G#p^>`NXQ7ev26&3KEwF!m?uwmQ7C4}@~vL|z*>Oto+O zhdy+nJ!<0;wX^7ZQuU@2M4tP{*l^!mH0on#e_ti{fS+||V7X+4zMt<=r+4Y14x)L~ zgX#kOuD-|sFXHjt>wO4<)2&%K~G-#QEZ>Xp5c za3hiM+FWjz?|bwyZ)qRcgSdS8yX9-rQ6iyABisL$I^w~$U2b`;nIi zWJ0j+fQp^+3H$}~0fzOR{R=I8Z@Gya#q}TyD0=!2bu(Tv?YrO6S9b7}krm?E)4~b* z$dA|`N{QshRn#@o19(Q7>yXEPF3sQd6aCuOCm6`UIrkp_mRqBQpGfAXmRUny-mKN8 z)rUIUm63RxT&%z9E8c(LDLCh0%{qG|)*)t=+L>iTU*h8k8pr#RZp~}0tt0>UJ8t#{ zek!ZEu5n~HboMWQo<6~Om-Z!OUPru@+t;t>dJMXTt(sH#fAD*!|B2nh`x_~HIdm}Y zdtQ1X7rW()CA>ddozQ-9PeM|mX1?m_o3 zP2=F#hd#ow_TMNE^pR*A+04I0!tOYShf?5(Uqv<4^w6c^E&oW2mJ$hCot0O}Gr+|J z+bgp#(09%o(p`%>nsUxP^@ma5nSV@-szF%axAcf45d3WZp3?LZ>VTC~mBcwSB0=-~ z$301?$8maHX8#ENivPFkDzhZczs+i)4Bq;Da%Hy+^s4(kL6T*7J>VLWcO3dwy7~m= zGyI*5Y4!G5aF)x7(i8>gSG%9-pQMDYrIwIp+zUO*wM;?&whrDGe5CapzVE3*;4gLb zS^Y=&ZDZt!^Z%audc=)L5LI-PIEmwpvV&uT(APduM(*RoIKO|5uVn*Q2@#4v$p=6` z3qP)+odSJKf!bOQd{sYc{Qi9>k#NTCW9t^`*~M3x%lK)*Q(*!t1F(OE-6~t=cfh9~ zI}S*KcOAJ}Qdz+(^JC1<4&lDO4U7!Z!hOu;F!-+@^H=ZNO13HV$@pWLcc{tWZ}JwC zE>EJ5uW$WMJM^S~q6rIW;FU2&Bh6c%aGt>H&aL1W=^^u2ddyGq=$yMO(2)+&=J~SV zKKAO-sDvtmUjk_Ule>g<4eyHDw&XBBZ>=OvDL7GR{a0io`U-10a&NtdF7~-!ybXS!$BkG0@MV18{=OT^8t@PA zi$#YXpss#NqVqE5Nq>`TK^wTAn~l3=5q2rjXgVX_i*Y#&H9F&{_dtPya{}kP@Ydx6 z@(~T22T426xAads&b*-tj;M2Juna<-&M;+Jx(5EWXJL=~Jp7fBR(vom^7@AJ_Nw&o z|AXgZ^H$&oZ~qdy41YZ`9riZs75w18JwePK(EG;@_58kt{7aKJ+DsjNT|x&x9fIGZ zY|npv{s{V(ULW{yj0yUFdR@s|e1CLo%o{53!CK10#U5}>PMA`ws66V71HO#;@W+95 zrt?l&(7_z(#u-Mz12L7A_b{%hYyNIj@H?S}T!My^=#Q$)+{i*axo)Ye@Ol<;qML z8T*2#Bt}P>W2~X~sJ$duJ0ZU&+MfG>IJ8U=)906hx?kNF&z*ffJ%66zF30sdZ#qMC zM;!Y``+d;yCiY$UcOjub=wk+D})|CvmOJbmuwdrBWpBR0qJZ-Imn$ z(#YG()#ZAwp|7-YONZGN*Re%-zj*|>S57#y;4QfFY^T@A2h?$nMS6HwV*H#3G8pmu zO#>%5ZPK7)LPmW34(sMG^DBI-gI<>*lD!Cj{xj)wFeNzaMlzii1CHg@sv`|Qp+~e> zFKZ&7uGIT|E*jU_q9a(_cMf{Q)L+LETz?^|j`pFI9p0Mi-U5$Xo+rQiOURDk;Y!jQ zEeD-Oh|TH~xM`qV>~J_ZiruM&TUsA~4}Nx`8}+`th0D@n=(jp`W^O|Ob+T7JhH~`s z=qpc1A!PxVE$5#tYQGH*D|m9|gA4kyDq24Fcwt?j9Qlo6f9OxU5~HL-u}^_w*@?Z- zvEt~Mu6w`5ILP>(mQ+E{`gye|1-ev_PmD9`7}ggq7w1O*MjzM!%X^P;^fi4>u@fIe zJu^8#Qvv+-uvbnt2%P1x$B`ze6I^)krYUm`^swuW3nWG0q37|%bMLY5ghb#M7QFr@ z(7VSCI#$b-$9oN+j~%yr!6ON-DmD{5F@t*L->B5EpYEtjTE3yUehvHGu59_W;<~Ky zXo+fzV;n?-XB#J>a~Vx7?&U*YmJSQ4>j~sJ$5y&{kKsIuk+EXnt&7=z1I^g5&a-2+ zP6K+@Po9$AYV=jjGDc52Q=*S78|VB`U$7#Rc=%dyPL1_H3H=knIAFyhQ~QdiRi* zoQ!`)gZFWrmb{lra8$82~`NLU% zDa!pU;_3esop(H!Ulhl!>||7SR?5m=34P71sO(ipM!rJ$DV4otSE!5-i4tW;p%Ai? zO-P9nQ7G&8@z?YEuIGE7``mlZ`+m;3=V9|;5>tR377)Kob`i~m{*YLl(!hW6>;Di$jRp3xVLk|5 z8dW`i81^BCv?>(yh44o5CJp>_Qd4lDZYKDM^_6_lE!0^EERRx6M&3q{&|7Nw>8Ojt zFE98&rX4wY0G3x&zZ+-iTqpnM~Vb zU2^DRQz;Bgh%Zfk7mlDAM}49LSKsID0td*rr5eEA*Zx{~6TFCcV`@j^3Cwdhf{L7K z0oFkW1aHVSz#gSjQ;T(Bel>c@H4NdpZ>`6d55tc5(f75qf=3uVwco>j>?yr%V|yL( z)PWb-eXvier>%cE%0Q>QE&t6W$Kg3Z*XLTc2ulJowt3=g^rpH3v&_5Z^OgzekaZyt?yQ^*Ra2lZ$>@kOSTE zIE%HtOem2c%ul*}E(E`;A1`E+!ogH@HqD(2Z;}UHA`i zJQojfBO>J z#9_D&aXzukI{z*L-X~4H<8~Z6*@JKTX<9@=c6V7%DRd}>|5{F8gURL?qnrEKMan0R1+6-w}b+*e}o> zwe>3)`p}Suzc@I%d^ctJ%?a>&vWRIExS};~R~i$>O?#D7u=g_Vv*mP3G1e2rXufyK z@1Qf*i8N)uLEd?f`BvYn9o|>HGl6l%o_0g^9r(v)iHp7jI%KBoaFq^t`D^)QJ{`;( z>z))TDRaEPhqZwY>zr$joBzHa0T(?!O-?R>IwaYHvW7>YU%K{?pH*=u=oeJQ&w#_u z^fOcW*rOhBeNFDac;xHPc+mzIqh9Z<&>PEaf{Xam`{?uSE@~c`{lFoyBJ4Rn|v`8b4RCr8MPYZh18~f#H7sM6U zv<^N3|6KZXYn=`HORn5vY9juh{BVp_Xa(%2uBVB2Ir7DsL%c87A@7T#Z>k%9#P+f0 z=RO>l8^Vh%;77RAF+FI33hBx`i(tDz%3ygCN$I+!K2%}VOP$9|GF72{x}Q2;XgaGQ_t$) zWepykVB|r3EE;(RKSR&{{(3|q>N`Bl_3eWF43_=gFpP+x2dd(->OA?Oed^a*Lh{T%Qwvptpm zmilP-Lf|!9^na4*e&!56tpA_a1g*v)e@c7k3{5_CiaT!Si0G$bvr8^P;Hu!$sgHbf zuwK?W*MA!QEAvuta|ExqBJDp{qMyu6gC<5}y z2Hj>N6mgxOJ6gnK&|eajxdPC!=EpU2romS{oKf6n;Htg9o^APa;JKe#6UqzFuN>bs ztvN%#lGgs5n74uTN`#rpYuqpGb-xa;LB!+9s#VXt!#FFyfAv22x+6?nd5QKG##4Vyp=N{C==z-KL!g!Y6}Hg9khKHyptW-NMMjd$Bj76PaLt9d6L@WBx#EDMuYVn1(&)RgR}HeT{ulb-#%kc)#zu_S*_@2WgX0*}V+Jk+yZed{0IE z(Dw&jXFi_WQkWV14t|9!N99g;7VK)Mb_u^1^qj3E^)v$VE=K-v5I7NUFz4DYNCvL^ zXJk9I2kYtgbDu-4;V%NW{|;jP9Di|2ViQ~ud$mHzHb*emZmpJe=& zudpoa-6L%lLu1?@T2i48<0ar7ttU)xQ!uZej~f2+z`T`Tn|rN;b+XN6clfhk`g=+H!6U~nhH!(gN=O1id`l6BldOL1(u{gNGVzP^ z^YC+09&52wu-AS5d%D0`kLv4*AI5P#p<;KqpMaypPN%X4Vt-vPwylG23{Hu-q`RTc zklh)L>LBpvh1W0R(~ks2%Bc!z;jfdTyoim-=}m9)c%M?yvl^9|2g_G;&5N{ z;4wUpr7~|UN(A{|2h>#5dEoCe7RoL$BJb*<_qp{I=s!|N28suWgz9;-J5JR^JZJmC zRTA)qXX2iKIp|SkYg%7J!AGW}lI|XUs1L=x%T*5_a)RiiDlKd7t%*b{BIL4djp$|88YQg9H+*4-YsSS%OSNp)>45np# zHJDGN=cVsTzd+oLAymAr1o?n|`&@=Gzn)4A-3W_;9$FNfuzh)F{5_-KG(kMB)31d} z3i?!z`63G+bg^`jl=nCqTw8eT&WrVu?N76}{Kyv*`I7Qh5&CB7&jWYt@I2!CFuInM#??>mI`^ypgUS3|m#Sb34{wDter!Jm9wJUhi@;c&@yh~gS{N~ zkl@?dUpFt<%;&2O&U(T7Hb4>asg_sVD>y%&VKBc2+GBibOYkV#v+AW?!LSaU&8FFf zzz98xQ=6c`2ab3kKCvVLu8E@xDui8q&n3*Y!)vZ>*($UlJ9hjNu{#0l982+5cks|} z-x`}^;FyW-M(Lfpo23$aqx8bT0XEztn>Vozm*bdg!}n#GDhzk(R^8?}X+VkgSCz2E z>Skm89{0`WUJTYt9|jcu0~gJu&7K{_^-$NE&GWfK&pQ29PZ$5=ttng(nvTyOZ>v`0 zJSj!u#wlUgpY=1EROmnGLSmP;6}@450)=eMA*DZJD7+D3fw!r51H)3A%CJ&MVd(5V=>EZd_{m+Iv`E@vyWKm5us5-D)% z{t{9%_>)FOp`|0N*x%^vM)HgoalB*Z99Hs(vsRuKw*b#d3Nl?Wu!kS5wBv9iqTS+N zO;Xpvr~%E@ za6#d{^Ik1aU+vsn(z_aNJ#+elzgYRoTE7C!u$p z*!v;%cL(Z8TqdtAflih0U~tas9yrcRxVAG4c~{Ye=Pj-wk8F;EI}FDQpl++qZMr7ooqqGr<K6w>wG4_{z)M}D&iPHqWSXYkZe z!2|XZtZ!<3Xq$Weao#kKvQ;OH&%YOx`SHDL&s;dBVJBJ{HoRL{uztDE`3; zSc}i!e7xA6;ehpw^81M#{ND`wbH5(UBhPud=@j_w`MU)x0^l==Pni$Ski+gI(=#oC zKl~?{%cF7RAn)%LhCjc(`S?T?>?jvU>x~nW@F%TT5-gy@cvL^WL;Q?<6Si>o?@NeF zc#B&GV7*GVP1co<^>}1wz4f@d6FX{=hsGBGx zq&OdjdQ%2UDf_-6zEDzJyp4Ix;}?MRIOu>!cuRKn4?NG^<+U4jIM?fF!gw+A`k(5w zyv1wN49)*`KBwYY?CV8;-B#fL*8;n{JXu<~zytm~EJbpI2G2Y5=vJE~#dEA^`t$z# zi+q`c0D4CFfgaLVR9Bk7QNO&6DyooA{*Zp;PY<30XD%c98{Bj0r>sO38}b11kKgrV zMjSzL;>oX{*hlv)IH$A$Tqs)kLLU4SM$jsA3&D9;8ea|F0GEc3Z76}eN?tH7vqvJH z`0JbEUwn@Q_jf=1=NaF)fZ`9x>k&1)Iz)o_RJ#7vzXx(eu{eM!vA7*ZV?HgXJu~+-T+Ue7Ug$cME$6_ zgh?9cL5wsPV=BNc!i(QEbn#m9o}#`UI4C-uDb4=^_JOWh6ZxXpQ!| zT5JcnAU-JeR?YK_9oj>Gp8EpY7c}gva~tO&4?I1`8%HEa3&t#lWZ}7mhXRE9OTc{w z2i|>pi##p1Z|h3qcutc1F}h#Sr`$Kcb99rS&S!-fr6f4Y#lR;^cLQZ^!KFt~;7ljGEP@CZS};WKpt_TN2} zj-5+G9=m;Y_cQReXwR1Qcq8oV>-;WW7TANH6D%YjFrWXNm}=U|TjX-MPNNR{CGDFo z)xn5-Ag}9`#^9($I=a0yGvLfIvhHcLW3a6+=lmKt)#e^88NSC#DSG=i?4+=a?pUNO z>gb4HcrkVg_B6P4JOrFWKU9(b@jC4Fy^#rN*j?_|%Swabhdh(-IiJoVuBMbmcOG_I zyzkAmD`&u8@)WG!unyKf@pCW;cH8LONB*@7&}Fn%!&nZRjst4X~<$debVx3Evj*hIqg4fYAlFH!LRMgG#QznN=@-xONQaMlQ+{?N<) z`#SewpWE9pMVmSJo%H&%%+<(WJ?#26`X<^P&qHz29`RRV{HD`UaHVlDBPN;+b9&LO@P?Ur&n1^Mc{ zU-PSY!9i-rJaS~f4`Ycb*&1r7GhlpAYA0_y`0ddekyzOw~cJQr+dpTFi{PSZyNy>Lke5`pECa zw}3d@fQE7LCyXEM`AF-Y9X(^7s7pamcp~wSP%TzUlgB@d2v8T{~YE$eFAB1GVFr> z=^5$@jH~KE7opP@m8zxA1#DoudQ~eXLi^j-I_@fbqs@;K2$m+ROR$>5pLe*`M5rOqfTXzp6&n zgoA@fPB;9-Jni72W2aC+d|IU86Eo%kf%p6FHp~mpX9ngwb+gEfI*wUhMV=zHO2UaW z}0{G zeT71$5@@eo@o0r0)`hWs*R5cmI0EF1B7_j{wl$AYlR>_&uVah7IO_ZS7yRZuEBf`U zM!yH_s@H`rJE}(bg^!0mWWYWj47t&K26lZR$1gmB7d$8B(`S4V@dG6-x5WpDV?F3N zkc;(hr{l55dEg{%i3Nvp%u`>JoRQfq^!tTM?z1JBhY4dn#ZQn&I+pjV`aagRY40y| z!7lcizhf7}^{~v>trtpRU8S!-_!a$gDoo?}5F6~*5s&c-dh9DcY52n*@r@Tm5&9q9 zi1UaXl%#;p5UZ1|#P|b#GyA_Eqp;r|oB|Qm(EY4vMOz+A!miPl*DmeFc|J}RP~rN{ z(?0W`?Zi6YjY8O}81Wi)w#4pavijlr{-{4ujX=GGy8C?IxK0y; z|5E?9g6}FS-w44kD6S`7EaitC_3Gf>ID~a)>E&$8U0A0^T?kbIR|TEv+w~*^`O0w| zj{7`zo>L^c77PF9MxH}>%?-b&c8`5O{61d_=W_WB>J7-p7SDbl66QMf6pdaH3CB#; z>%t0=XQeecbOPM-Se44a2>dbG|1S5a753Zxy=FSB0WM0N5KNQ<#|W@q+{uqpw{N#O zs6-^hGi&YFQ^R@kyZ#6wPh6kd+mZ%cb7j}u<0-`BeEFgZq{5Mx-u^S_V-%4PI~)?L zf#Z`nW$|fnl8yd`)VIsvx)=YHX3r6kcUP&HVN4`^YLott_YC&^jb9yiwubI>b$a9% z^sCxifjX4nsY)LvTFC$+A?L}5!s9rPrn<>Rdy&)u;NXO)ZhH_}qQ91so*vY@VeC`qP(} z99!{^q3?X`Gkb$^uv*r~bHCS}@bAn?>7X|7`I=t&5pWknrd25s$F6gpGhX1YLrOBc zc7x0ApQw_rd+1Iu6j_#civyQ!%W2ZvAs^D#fGZpS?`rsnCJkITu+{j2@e7f_^Lx5l8S!aK-5B@&D zg78HScIClrzl;dhN0(L0+;@ZDeE7q@=HY)-9=xcP0!NLO48Q3agk6zPlx}aqI){#Y zfgk;K?}4$#Pt2QFQqR-;7r=X7!tqLbU>Ex5W$LhQ3A{YqSOvQqG@kbNwg=*O_U?|i zW57)=qC-Im;Gw9G{5$)X&eQ3|(mEqP$8p2bz!2;13cveJM-ivL%YE7n=jm?`@UhE73CoAzE9$!)Tdhjq zrkCW?Ea1_6CC$tRa3vQ9k$nNz$#;)Rv~cJ3#ycXl9rUg1|3+inz=<|JZ?#|V}-pN^rX9iUQe&%eO;UM#lwhy{Z>3*tcrff z_O&ld23Mstr8dulD~vs5GM<5lhV9MrUz=c`T(~b)AatE+f!U6A=vpqk4lT0ak@?H# z_uR!%Zu-zyd2otTHlMLQ^sUEME1wUag8t;x(Q*Or+cegk4>yFqGpkYh(jM(ynzwo# zfZt92xiWhf&$BUnAA9f_>WOal`Q3koxL#Rs)2?>tPFxaW6X2;xlKWZ8IPR-kY~q1# zwN{ug`Vd_8OW?~O9XPB;KHL2vzTaZ|()2(X-v3rIcrO;uCA2o~_~-0F=%482p~3aO zNm3a10zVzyZpl6>jr^&XRX2T+H${^b>GB^R_9gaS6aET*dT(qH9Sxl-MRjrQ0l3qT zWH;qo32>!}@8x7R^v^55ylY#~CA<&2v3D*9{xLK zOLg@H#(m_!!z{ReLYyk@J9XYNv=mj`FwTCcP5nv3eWVmHySxHDmF|%06e&21u=it@ zW;eL#GFuiG&KJ+S!aDaDexB0*MKs3$V$@RJQBRDs^UR%07)SmWcQ;qUP8gOfc_rdl z|6FL|h&6b9Gnl{17UOo`;9L%P$*zFIMG@m`|E-I;-&|1_-iLZP67N5%Vqed|xD=|p z|2Z2xA%9SB->@-sDb?_MKYb8~Y)ffS#(Yoxz2rj^2maw_QFDYn_*7IVO9dXQs#?Ya z&!Lx9b~JZLA&$iOT4o#b`OT+a`|165_HXoadZ7KBD=gQ~y~MbFZ|ZXs{qy?F9OtW2 zM zW{7V&>rZ^dy1&W%qWhPl$Q!9RH6sDNr#blg?d=cP5A~*GBpW=}CC=U@a0zyx!|X44 z4(wD$4rgXP_WRseB-LreeB>@a9E(Tr4Pl2tpT?!obuXN1|DsPx<6m1|=vS)a zE%~>=QD!vu3jR12Y*1i%KqMIXKXDlbABmq-Pgf0up2X^NwgtZz6`vIJON9<5Enh77 z5c~Y>dlQEb#n70FLgA9UY?`L+V&QCVnt%x7cYVCc1@LpXY-Jneq) zh)A$4-gbFW4gIOnXE)hL#3`jFyeXH#qsD`p%XHW;Yb}^f$%}s1WaDKK$G*9UZ<*5I zj^lL+AFc8Ffo<>}27F$>_i%(QTmhU?u_V_#l!$m?DVZnDOFU0qzu?T+D1Kilm7okA_(f-o z&+J#^KPI$lZ()2?&yDDv1V@~2J6u!#26Z)zPL@+XhfWo|q^*to$=eIPy>vbp51uM3 zQqYN`G}um?uHpU*GxcwOK>q)g%@4-!q2ndrQVSeFJam+?Km%NvUet5Y_#g89Ps+Yi z!}U*AU(i3#iFmd8PZ3E`=*dTtJ1o_p2hkZ``fdf?>NC}k-T#5>u6!Ql!8o=))i~LM z_Rn5=BP25h{yR~;AEuzjz+(L&b=G*g4?@kKLzxvZpqgFMs ze%br5OcQ*OLvGd->4d!I)Mu&%c)wLPf&9aMpS_C6Feo{_gT|zH@K(zcxJ#`0uEzId(EKdg(=;+;e$F2&Yym`U>zN_=f#DY zSa2wB@fXH;*sX&7R9z9^O}=-362p+k@+Fe5xB%z3Ki68m1iRn;fhHe3kpAca{VP}G zLrc(T?mVA3)5PW6Y48b!V};62y`o#Q_j^BeAP?=s@t(;C;FxmGhF~wO-zgp4-@r~L zR8ajoauECFU;b14bqIRH2dC9O*ue`M`;9`3@cVtNIS1j_7-Z8Ds-WW?f2R7|!T^5t z%*ia#)8OUJn}f9Yd~{;8*BE}Th&s&uAM`9bvAd!aH*nnxEdvHA@DKdHw+hSAFRRiI zcIqrBHF9o7%^}Zg{tt)LAB=n>=dBu4Eq;d#S!{h^8onl@2RYYizlJm z$ZvfnhtA`5Gi0|I_{fQoKT}v6bq9osZ4csmcmD~L3PT^$a=9Jw75rkhkJmOA`jCY2 zQPOf8bvJ&DapEZU%f2rgd0c5VR3sxr@Xh4G!J{FFH{MC%i%W$LRAs$j`3SE!=rpzhqGw6-i6oPrBcwvGERObK)>8aL44Fn<3ac- zQ3*)2v zXP_s(T%ftg(t^D3nDh+!YQ(`(q7!Dyuuf?%_MET8Jbj)e6xoLLMhkn)k1x2-AuNCM zH=r}u&R!5Ch5i>n82OCx$yz*nKV}Tv{c7{gXMA5=>fr3t8t4fo>eRRMasS)jL}!6- zezjlUd+!S7Sy}Jm>_zN%d8&9q0GzR=B&K-63if0D%myj^dUA-XwUZY3KYm*GKiCVt zNuhgB@cysS#Ecbt>_bj@wsrSB{wIb*hhG=GbVvKj70h`|60=c>myN zL@d64smg{{3-f@HpXpFN5&M%4c`tNZfcsf@73t&r!IN}i?JC%hTTQ0JcoMu9C%?(y zi}e?|wcVa#jQ47qcGCBF?gYa-{yQJQBTRv^-$tO1yj@Uh7>7McxG6T&gL-r3gyUZ5 zzv#^agQFp+%Q>;=>I_~S4>`V9My61KIu!yDD1ALX%H z6<>kh3d>rTYerlqwyfYWEA;tMo{pX8JYPyTn3a4Az5Vx|rv|w1sZD2s$vz{Fy1akY z8`qUgzsHaLG5#;^=$_>$@bQxmyylqKE45mG6wrU(`j2hb(Ein1y9(b+B7gIw)l+IF z*d^sSqbTTQBgBr?Jn&7dokNu+7wm{&I_)ksoab@#`wo3@dU7)FE8NeYf!9{tabH}T z3T8U-xeDKH?M&EDYLgf5+Z%W4A+=A+dBPv>J-|W@zmz1^y=jMI))g-&VLNaopP-^m zDD*4??&}ipi|NI~$-7^mKE%pdg$?)%i!0HwH!9%gzXlAY-9xyxWq)u<%0umW1@KD8czm`6xW+>)^`snl>9W(aJL89-4@LddVAzX#Q8l03mzhy# z{bI~L9e&imii`XF0J>Iz9sgcKL*#8uQa@^QLwxP|Z{oiQynj^uw*=}N_&lwnqsT|y z1)8Fxs)eZISyV&#gQMM)>0TD(kzdGeqqG4RnYUlwGY2lx6W~+%_8dBtp-atkaG+B_ zq+ow7>NQX?pK@wIdq}79pCdnt(yGd#dl1jNA-@vX3Vm*WK>!`o65^fq-+Al65#He| z1oCwpf6bm$S;cb-1!EnKE)og5yEiGKz9U|!b30uS{nGPm=5+vGC#v2feGMIF`nu<@ zZ}`2ZQ|oIQ66i6v&WmkQW50zvDYG6k?vK;Gt$yfP%L(C9>b$rw^*@^^xRAeoBTI!6 z`jv!Ra?_tp1z9rI%<9}Z@r*A+nZTQyX zTQ&gQsfG1(OC9vfaI(5P(6Ro0U|pZSfq1)|@A5j%AAR@4M%6Zv@Xq&p)-Q~Mq}Jg> z3(eSHLN;wY(Sm&fs~LmL9YjLCkKfHp;7sXX?JF+ea+1fp?Z=>dy-6!JeGk2EzITty zxB~L~UZ*qJox*dWi1NAH_RvfJi(^Xg2ak2trasC>T$DF3+ZXdY_}KRF?5~~rax(Nz zThLvTcKa}rVt&N;@o7?FJ)|!8=^-bMc@4F96|hdJtvC}8dllF?II^?8{A6`sBY+#+ zv-g62KF-tRfAhT7F!IN03wN!5#Q$7lU`T4i{4r1Nn|%b`u-JvIAR0Pj^~b`ZNYwEP znW8Mrf<37vPi4h?O!=#B%K@E>&duk!2@CS9UOyQXg}t@Yx-xMy6n1lPe1g3keuVX( zYhnj@g)pZU+JJRb@aE%d_s~8(zp4~=ZS)~u&1V^`w{2cc_|suM$#Q_Q7`j*-k0i~J zPvFY1FtR1I^W8xE>&8j!qc&sDngJ)DDA+Q*JCFQ>l9kDYzu1Roqi@@^4{-oC=U^&1 zYf7M%s8~=06f}LXp>&Gt6sK(Y~xK3-=_u^=m;O~IMWA=!9>`%M9 z6W0@^6g@}^4s2dO$nJ@L$?_d?cwGFKgOSrbiZhH8q_^>yAx7tLmR1SSB$aw8guPo|2(FJbU z;ym&HvC40%AYL{!*}PNFVYS{NYnL_nY|!_6G~#hAf7+?v+ItYf_q_`hMc&niOWZ@@ zzIa|uWyII|AjAbf7*C#yN4}ECh?Y+#@|)f6h+)q#aYv9KjN3t#x;7YhzqYQEC!7reiq>Gl+y~GXQ<=jUFaHl z8V%CUb>J%V;H;0$&{w_{<}TxVKGkv-ic3dg#z!JO{+dFkY`#{a)M+e!00kX>}0s#*_Dhdhq+*lmfk9@%xLR z_3u56F|Wklai7Dy@F=`7B?1mOzIIT52IKsuxkb%b0^*2j-zx{uFE@l(__x51M3NV( z)Zok~Q63+{zT$ezQ)>#qDe|UU+*W;DYu*}NL*yU$C|T2KLdRzP8XKyFe93LFUG zY>S$4oC6Qk53t+jK-aG}smuT`yo%@0ISG56#C~tQI0CP4Q5y@rN8ZMl39T|-f(>h2aaI8SHqPC*_@N8t6}}91mitk%#c^kLD|O z@TK`6dy_EMQ4&R36hhD)#rNG>-~*>|pWw;C`^~8|xAVksz1!XVyRdGp4xf9jlneht z_W5C?0qPZz1~5nRBY&oa_de5M)KBPZ_wLq49OwC~1bt_4lWYmAF?jOtps`1P5cXw> zwsA;DLD!=FP00v9afRc^UHw4p)30v{-+4ad#4A^(H_#`7hrY;qpugf<8y#M&ArCr> zvep^#ojU`Y?d3FxV+~*WxAqf$lV0ykCj2V#=q_0;@YU=7i`7!lZ?se1F%~5gQ9s+` zodDu#IlFI!aGpgTxqHO%EOork^WZ3x1d;HC&3SjbFp=TAvFK_4Dli!6%ldwwjknV4$lKg z#gGr46H)pVx=h-8hH#_f$bZw$3w73j-Xj#y*pZqf> z2wmBJTNQ8%J;VJ8{C@AaXhIY8q<8%{MpB^D$Zn-s-Ut8eoq8vBbs2eTE;buCpzEx) z{7sGnZ*T;Tr(K;z9@?)AwzR z@|UvW+OGB>p6Gex$`$a*Z?Tcy>kOFJrDv3+U>9f)ob)sKjL#3glQ3#To)~vX*5h1^ zx0(86aq!g*qmBL7P9X0uVXgHWEqLtD#LbiA*e5CHTy?Dzd1jr%e{O)UmTm6S>^v7J z#qm&jWd+8G!Krk+M#PiLB>Gauu+Q_tpGS@4h;QaUHBx|%C3B@Bs7V*~9%@21^lZ^y z`3ns9E`#U!1t&bx5SLp@*(Z;7r{BriC?kjeP7A27!aTY!D$GR50UpT6IM2)my`ra1 zy%6?n%lTgNAo!wbE33lsC|;in+_Q!GejqevgA3eJ5p8C)v(EBxt^C1V2YuGjjfBvE zyv^%>)C#cvuxY(=?8F`DYVOxNjRU|_8w}$$3CQpK{kCwq678v}-=G@=#3JduuItnfyUi zDcZkA42y{y!hD_WHhi>>{7kMGE*aQEF_VjgHf7jx2QQ~>*zMxCUw^g^sm>^q0hlHXIS?H$27t(?Ec<20l%ghYFaAm1%H#! zKQw$A_bEcO~heE;QLLBwL@1<$vgG>0GJzs8&T_5=L#kptBc z-@%a~e`0tx!I_B$=X0r`R|!x22w*^dH|@H2F8sZdSEeL|0G{L5C>41P`i!o;#CbF1 zt-IWg&rydib>1%LX^RN-p84-`7ogh+#I_!8V?myGj1r9&xbnD~k`Nm|o`3f-oQoOU zWGbwGE)H=qZ$aILdYsSV9&=GU&VQbaz|O@1ZfQJ!ClW^!;TyT!!XAW=9j~0!z^$y! z*}8hryB4!oQ@6oc&XSfHHRqA%UTgD!%pIJk|{Qs&Ws)v9)#Od!c;y9;2~8H|6W(*m${0{lYkQ$j+0pCfhV8$4p0uz zp)hx0e=cHLF<9miuhX?nPXb@|4J+6xOwY6LL2&Kga4sF27gBb??fN*T6i@ zKOlKyr*4EeTk!}3=FiRN+}jIHShuB5|EM28JkzQ6@$?|t)e^N&t{3y`+XF|H2CQ3T zF6?p2$9jTs^T(Sc*ge%V&4mA;U(3GFRMx=#5m*)c$&5TRu0wO?q?lh7wfA?y?vI=B zh3!07Ip1P=x=j-HU$v<3hb-(A5BHJ2qp0JhahEg}c7cb~sPG6Q_@w_wfhp|GW*Chj zeN9w{dX8b?)jlQ%r*$l>I2|!Z(F|1dVwu z6j;w3ry~}cVxDALZ?t{q!@k^z|7fGuplc4^NtW(`&NN47LRpG=ZEi9W6_0pgbI@6J z*b8gdwzU-W*X4#P-s%I;!;6a!jMCuy;xvC$ab0hI3l}~HFNL$MGU(ubJl%5fvVy($ z_U~2p`GNhFsppeRaX;w4TPi!@a|MrU7FWBWPyC~;Sb?1{aow-nD3AQAz2UZhzzdTK z#V<^ucThTO6>^ykD=(hb=W#sW_iO3#-es%ig7@HdW{@>Pk zS%YcB*|w;jk0KtV{K0T49e%XDwDnF3;%7ODnXKl}u}(ji6O_4&x&`e|qNQVzk2LV_ zmGc$UQLtbp$wA!k-A~%-AI8vwEIuk|njvpVVx`U)`Q+=hg)MGT(2wpP2nmHQwa>AJ z<=|`NeHC*z&p>CI?4VzFL|k%aZ}(uJb8K_A-xulW@8q_r~onHVbM8)Zs) z*nvL-3H=zYh`V`@4BLP+o_KoBGP&b9k+Pl#3$aya)u87%+`dy3F^c>w<&4Uvm&o6%EwR?Q2mc)v_a+1VHLxeUVN4JC zd6d@$EOA|{v~g(%(9UF0QQ9SNR`{>Y$YtD@>VFnqRN(Gic1L{9V?2-tDnxVQ7&kT- z(^-#r>tTjZkD>Ej7vFtjkpp$Cm=4;}Yd~M6ADRg~hv%H<(Ylgcfj-mJxw!M3rKytT ze`;u##t|cR^8K(IuE{(*c}~7|dP*UJ(7nqhcQ=Di1a^;->^!fa=Cb&eBMMmmJnGi` zE)08h=i2KT%)b&x4Ym0;=)cdZ{2n3BHyNYM?FxNtGF`U9F&Eqwf3`6(75i`xy>|D+ z{9wCxh8-76csJzfIw8uB;DXHyF zJ>sqeLO8g@s*@recK%^Zlay06IBHR+p*{=w^bdLI46%Oh$_^CNgPrBSQ$$J$JCSnM zTJKUH?vI?#LLc9n%LD+$D>lPfMA_HHxmFDDDkQzF71Tb^co23}#^)u7pEkN;P>uSkyn z-&YmDQ^|=s5dngXgS(+e6wDmT7soo+F5&xWT!+PMgu{9GFKau+A45xsGalV*`J)>; zk&qjmS_SO3RJL<%34W(sH)Hew`BgU?&QgS6T{%9VwX;7f@Tsltq&C)@Ys-e2y3jA^ zlj|=zB7Vp={6#bnd?x14?g(y@G|ngf4TFyHiT**+4dk~tJR+}f3OMvLfLz4 z9R9etbBkOW93Vz%5@!X@T1vasm$nCWJ8wAln=_%#(k<#QiF;9xv)_jx!3sUg$L_K_ zj@EmAHK*f!@2Y_1eTZ|-nkY=41z&w+9<`R>g`e+r@HqpWW=|(oza@AqxHc!WgcBUq z^3`n-I!kS|r}0HHobQK%i61%g%+pHBl)$SuLR2Q+1_F+Gety#GAc$RDB~3ZBde z?bMNTdTw)&1iIDu`HpNOaHZl|lku)&;IYy?HFfBAIud&Ne|WG@b2WJ=0y^}HnY7=ji+|)v*<;2b=$IYLiKN4b57+uv@6>fYQguY{`yBL)N4_U6{lWNBl{VX4 z#lDrLt=yoWcs)Xwz<_Z{JV4iM&<6c!o_RYC^DKytWY=Nv22W|t+x2L01c~wNf8eVA z>h}8|t+8%M6d-f9MZ8`kJL5m_RqLaLaB_@4tstovzRBR7_D5Brq0mW29IuXCzZw7yrGM@Hw?&dfK${4%$D+3kdl=9wAcZoWY-=22m%e{UT0x12%N{a)ah?$#5=;E;hV z+7mnb9Dhv`CoK%2E7N|fk-<9jghQ(kCDzsbIcu?3$&tTSP{|#<4{_3?-F^iE$nRG* zt63I9K0+3bq>EWMdY)uUY*g80FNd)G}}%?uiLFz7ORN$*%zYWm=)r?w+wQO z^)Q||w|-a)AaAg9pWP(xuRVV}-|G&-Mcw`P6F^6@!;))B`qHAKSTl^Xjb#FbJgg2IbG6A2c>K_+a-pFYxUJF5%* zLp-HwV;x-e{N!Hi@9@(OP78-d(N4po9K~-q5#NdWK9P@pcxaiUtaKLo(>$G?NdW3f zO|!Yq-GV+MJl&p{gL>w!-_otY-Qj`aB9rLnt=(J>9Z%rDe0!#|3Q&ilO69g}7V1cS zdY0~!4nOypLxK{=BId+dPaHK=zsKq0di3j!ugL)N^fjvkoGMoUU_0(i22%y7;C00b z3z|wCbt%qGj8j0D3wxXSoE4naBXRGp2I`mSD?iwE4f$1nIu?ky&f^A#iUqac%eg+A z!Afvde%RVbFeY8l|L7Z*we=4rA1 z`L%vlN*UvE)mE{}9(hJY?+?jAsCVmG8Ru1q=X@`T|M32TJVB=KqrL3ViDSeTTn=G= zO{Kh+;)I`XILxX5`=O-6LR$`=63NW_Dku$Io6d^i0Ms%@QQG+MlkG!jrLDt=w_UPGGx>a;OFQIzqDMDM<4W7^eFDPmmld1 zr(w*y7RqimaLA7f|0EP8zzsHp+-5y+O!Y-wIdIFqfXfT3;F!mou@w}s@Ah18OX+ab zG`36Shn?TGI_PGm4!b|cDc%lVG`(y<#|!)L?`p{p_bRNr#ExD16$4!?EST)E7uLTe zTxFu3Sa&%ryT84G`mJW|f)mgqJ?d=w{#Af~&9B%E&LB>y!KHZ?{Sb5P&8RcZf0Z=e z=d%O;_bvT>r2yz-YQkwb;1|afUAGt_^!Td^SNrk39!vV0&gj?q$>DKN60GyH-oHHv zJ?@cG(y^1*a6Q*gQTKM?_45KcGWfH+(PmexTEuG}Z|!e-i1rtnr;ffqY`0ak-uSKp%H|-Q-h(T@SrH(`v4gOc9)?f*Cdn>>@xZpSX{mY+P0r1xWo;|FW zzGL0&XWQNR4bLelr(L{(*JZiw*<$eL`$sYwGr>i&YKwH)h-Z9h(H^}F4vX4gjP?U} z*>>6=)C4y~+Wm01f`2e++fuge~5Dyz9N4KE{b-Pq8q2#K!AS{b*&L7AHeh9j|0va>pVhvR-6w!g7v zi99jcGpEdSzXD!)8+UpP}GQSdR{Sy7+`mW?3Ir_Uzph3nJ$6I%O z2)ocvXU(GQL~y_Md>fP508i~=d3nqOep)_vSNL`h^sFCJC9@cZ4A(|}a$|hl%ak~@ z4ZeTYrEoC*4s`j$9n6O??m3sbhBm8F$)09sn}WmUgT+$8SE|Xs`u5#M z{E9*|f2aQcuu7`scq!sYZ(r_-xrMyz%IgJf7|(9x@7dOlU3&19;@-cxA_oxHyY?;b&~e1Y zVjhjCX=6R0Eo%7;$G662Yi`z94>JCaG7AJJU3akw&jLrj;M9r4bye3$9OMR1IUU@t zz3GE-eX4A3CqI9vKid5-&i8l0IG&OKo}m_!Yr?$$G^iZ=jT#&3ButNJGP#W3;Ydx`$4_|tfd>m=Soe)eQurso83jT3Wevp zp1mlCf7jsG*Yx$qeyUaDA98h2pHKNW!~y+CsoN?d2hxaZxs>A2-{)6x*@jk(20)D8sxk#<8Vuw1hLQjKx za`4M%?Cx^GA77Cx6S}(qE;9Fc<_rH{VE?0G4fWe3250-$^001i=!N+O@YBoP=q)ek zO&T4+t^uW}gHqndcsx+v4PHaz#rCEgpL0}FYCDG+1x=2uAzBT+y58uWp=y7FOGazek|dw*U)tc z^5(xj07uB3|8MCyJ#;#SWGQ{Bh+tcqub8^6; zAp~vK@MGJe$AUHL;cq)T$3~m*{3!~x{m8o<4wX~7UW;{fm+sylM?Z`(C2TUm&mSrn z(dl@O{h*r8l@nwkZ?-t{^>POCvycAqHYOsEwBqEd83I4ubYzLz1|0n^aO4E~iLfO^ z_Rlfw+ayZ=um~JvubC#_x{CcCj5>>d&qMFY_H%eKhxZq{Kig4(&NXCd%JLHRP3>Eh zrS{;ciq&>yH$0~{nau|ae5R=3VDJN%Jf{0{N%A1}CG&}>lKc<($S2>kj#8jsr`NCU zpxr`=@Mc};T7HjbvK{byU*8z=>*4!BE(Ri0$jiMGiafHXZ;BFq*|*2%(l9sKd-)_?1U7+<*}zX9w{Ijq#5j4wKB>4KfjnYxT&Q*&)*&1dk+f|9f6LPSPC~yXXvC+V zN59!pllX5S4yd6an|2CD9bnI4GZFBvU^;c!UcA(9MJ>P!uDR|tb@u2X=-E~w+eVn@ zn*ze^LgesQ-)p?d8KBquOZl?%fPcy!#7!N6u5@MXYSu64RBqeBxkZjLhC?Cg$1wgG zNak_v1M@b-oS<&VVOd<#KvIAdjto_~Wr>7%xuO-t5P?^>SiAVQ&PxTskOa zpoe&2Cc;z50z9o29IAx=Q4iABUjX;jBtNHa$9-8_&in7}ds^{@x|=~1{4nuV{3Gma z(mqScj3CtC5>f`2ATAb4lhG%Jy^?EPpRSdHzLv5e%T5FP`u6r=-)-a{-y2ZVb738i zZ?X|_By=Uu^n$(jz8wzSlKulOAr(pwCQv4$j+T6cUpT-Toeg_k8x=zrIf(pc-IUoX z?r*8B$!?FE3^sRG1y)h7uXTMjdK&AWhGs@z;yeoG8}zr^;IFnm$?okhoueJ}Zf~D& zQR>?B>hJOW0Z~uePvEVpTWPl7NY0c|riHglPV>%SECSs1k0&e54Ed`GqoP_l@KYsqe3a)J+V|Dkyznw~lJm@t&t{=lnl!!{ zo z9u?0qwxR7T(|GlRuQvSD@`G=b#vWK_*jn`=5&U$LM_}n3xXFcf5E=pM(f!&ItK3kL z{IIJ*8Rwbbs=E5w2l^fF2NJPBTzA0zT?LMfrlyaBkbhhX`()=0zOwR)Zn+1(Bkg>p z_2eqv6D{>*pDJ{R=4kRDN&LQ)S^)b41?Ylqx5=-Gg6B?ecIV+aT0(xeYD1TkrWNR7 zL;f_;BKu$>@`LPCCZ0oBN2qmu_VE|wXGa?Jnajbc6GmgH?9ls0wJr`t;=KP@KKGo& zc~9<<44;PnNB6BmIRWkH!nu#f?K|qJM!8n*)q{6Vb2NO&L>(V-;Tig9a1l+R)8Pjg zUtA=y70{!4>h+7#y%BG$q)9knTs1#+*59v<`9P;JNN$U~=Xnerm2V^cCeF**Mi2D6LkPNVJz=0Q&# zMevoZW2OKf;+zfzk6m2fW$dZHD~>f&cNQ`);eOwij_2J1za>s{7Q5niWV~~3nP7f& z+|!H3{H$UlmQe%8@s{aQt=|OSImXhOs$+d}tl)t^M=%f6TsOC2pFV%6nj-`+E{~gV zhk$3q)m_ZqB3@N5ok^3Mgx@tkr&FY&8ZX0XF0RW=1x z;M{A)&W4yL(HSZWnevEF>hjVbUE0gTCs6%Hzc;rMHn=T-FBeuAR~ry#y;odXf_{}! z|JY#>aagR5X}J+NF`e^a;l^>;-Jq^qPjKCs9fR0)==d&nk=6n5#{s6KGzVQVUfMgh2&i#< z_~5OqKKOfgt;1mex>wxR`_u&n7%%e-D(?;~}?Sub+~HDj9BJpE%VxhB8CwQ(`ZkiOE9uiwWJ$2RCYFYLxzCK|PZ^Usx&T zm&8Ez3$knAQF|-ql0vlqosz`Q%g{AF=#SOYBTvP|B&-2DcZ%jc*DKiFl~(fJSvKfw z0V@BUrbV5{`;lul#HcrV>Au`EgMBG}y37Y)ys^w5w0K+rK6-xnm=?wj(}Uo~{ova* zZZ0XNtJsJ5_0c;{7(ba`rHFjxa6iq$w`4 z;fL03=LjUhB^Rf=o)_mKzalO1q}mhpU6D^n(v(mSa@lkJ%LVv@!V4;k@F(l0eU|*V zADz^xSW56!Gdb_EOiR?Si$sgZnq&PZ;}7=~*i&X&8_Kmuh|dLY7P;WM2Q1R`7GA^t z&vKX%HKJ}-{9xFvZmdHO=l^*22kKeOugspCho7=ObSoIV742QQ-VL7eNq;?;XN1)cNG`*?09Je?30A^tTt!6XQ}~27ltGEhwYJfc1fG)e54r$m4mVJ`)`C z&Wp8V0{mpWHX=5u2c62$*Jca(6lLBPt-tU~G0zK&JK?9IT59iQf_Hp%3}!~aW4}N3 zJ(2=XU7CvzNdr$k;h4OTZHc_3@zA$C{9oU_&OzB8ytH6$#)JB<9@*)GcE~?Au=ve| z;AkT3Nq7oJ2PU`glsNjuzX&F9K%IQhr*P|QsH^`ub@>PGtMxPGR--EPvbu71$8%V> zSTMiV1+H4AZ!+-Xz&@lZ7fOGizUFL>p1U`W3S(l0(p=z3?l*G@;4oFqs-JoI-gNm& z$tdd3ihhxVpOC}84yQJ4Ux_2{`5@}TH293YF)W^_TJ;vd8@kiGdQCvGL(Gi2Kt9?{doCx z=!#Y*Pm4WJH^5}-69XiDLfCI$cgbBZ4|A zX~t*87~k4{!*^W4PaH}QWY5|{zYXDzXp@D$T6~Sr5$6>ar&H|hAN8R4zVkouNx!8J z0p3+0b1_HDNA@iA)qyOUT`F*)N_KSvc+P+Aqy#_ay@7}!(J#zj8HMkxRHT?!kCFzn zuRsT4TB^`>LHt557G92dnfLQmw0R=(_{%S&*D){LWDD4>pJShsdolNpnxa0e@r~2o zb)R}39;iZmE3A50D>ngl(n$Ar&vUFFKkG1^UyS;VLC#=R{GVOwnMou3qL$t3kskO} zp*x3`=$BA0N?Vqj23?J!&f-x{GU_uKAF#f_JRv^k!*v^Z^;P4mdS}4V=k8}EIWI$( z;>gJCZbrN|(x@ti`RHfkO}~YHj963fW59j8a+vr`qaFO1CN0!XLFcr4`<$5!Iv{o+ z92tP0cK9JP1AlCB`6ESX7<7pT8`Ckc^JY#PzGvZ2^sdo*EIfd}n*3~a6wfpJm*vf$ zN3g>d@g=l@sDC-v$t`Dv=OiiLT)l|>N$0I28R3_>jNIB;;a@4)$4MRF7u4#EP6Y{J zeZSkkWOLYMI^qIBUHGj|_o!)dbNFrP3=t6%w1=YVfft&%FI`1vGF-3TF>*m1ezqn% z$lMZsJZ|6V<*{$rFY`x8JS%i5owVAozoA2XJ8yK{#smAX-#+T_L-2yQ3oY+?@P}cX$lwgPgWPK< zwTTVq5jB(T7liI6HS%#<9K2=Wf6f?wiCh1^Yk?)|tr*S$%u~eelxGvd%-)?-ZImJ97pDe4?l7W1c5~k6;Qtp6FhAAeM_%l^`}|pa{(Ntj z;sx3vm@cFFAPMqxR)R?c6wq_joM>C{Ju-8mo^M=uj(UZ0H=J)hUrt$vzjLThT`NI* z%0zzJ8kvHAG*}}s^#T3TbXa#A{oqD$N-XmuxVFi9)*X4hmqdhF4$#e(I=H<&C~?1h zj)n2~-Hu9at=qWIljZumB=mdl9WZ?P5dCoZ;6cq|BIKJ3&L7PHCs~@Ajj17z`zVUO zHoOb@VoTvO#n300X3tJDK<8Bd(cY4nfqhsVPW#V-uc$naR;uIt)x@Ljmf+~;te!?5 z(8s8Il~;0aV*C^Hmnx?te|wZ#rW5@maGP>)cNlf|6}8t4zCvF#t0Nvjf3cAs=;8eY zy{@ltE_4X_+xdfK4;PTverR*Qa}nb{$|~@3*WNy)e+_@5|6h=AhN!rrKK$VE-q%;a zOXRt4Q-pEevQXX|Jg3O1FyTl0(5}&T1*XiHpXcaoi?lJn6t#vE9L=u-s8GRtJPtTZT$Z3x!=!c!RP9|wiZ3$IpZrkl(0K=&m}UHv!SO;um5=! zjrgiTSD_;S{O`*YEsy6t?(%A^*A`rSvVurS2jlQ~UY;(vPwwHE4iU!n-_`E-sbbK( zGF+mz&hu>hnG_;o=e68!7 zO9wwh#`!kJ26>D47osJXOrSq9`MEp;KZ!1{6wrEuQwsAw6~lf~J^5qDgn0V?Z|}mX zSolqK@WTa+LVi_&$Pe8(pwk$RI6XnTy$F7Kz?N6# zXBoIEo#9Jg6YA^bt4i?D z@BRKGT4_h#v*Uf?Hyn=`P}zLKv1@I7Ar|d()9;Jl2izZ(Xzkoo9oFH~d$wic`Z48% z4hNuj-4K!N9RYt7eya(-1I`HZZPgh8H;w%=74Cb@?~MKFyZPbaBjsQv|<^7`1^@&wN3;-?%^hwh~~X{ZZN-BwiR`u4RKxRrf20Oa>gLOj5J#2oAH{jj!Uzk&kileJ}Epwmz(M zPw@TbW~H}D$Q!yD3JVU4;5|3;<3h=NSU*UXuV#p2+w+tSQgBo#*%2XKtcz$Xf7YUc z^VXfl9F9w&-k;x4{~Ep@m5+U#w6I>%q|(O@`dp*_n`s>-XBnrfv9FFJpJXMJTjvQK z%ler`nlQ#)w8&le1NGn-<`;y=z{f9!o>E%}L$}dovgf*waTirHaU&J{u6>G6E*Il0 z>Dd#ybi@OL;zB*q$X6?R>k;AnmvIfu8vf9;zOYHKV;tR;(AL= z?;92|emyuIi=+RJ-Jv^>g7ci1UQBHnp?+)VqTyl0DU$>O4twhhe}4>@Aq5}l$T=wp zaY2WgzF?lmhj}B*HXWn}&S&N!^TqhSx>i5Il7RZiF@nHtAFO*lG?nEbh4pN?gxf|G zh-a?+pwuP8`244kX+RAw5k1Z_ehB%!XNJqwus3RDW#or3&)3B>7$3r}5VCrclHzzU zYS&%96!CwJ>bKNp{C`FI!V)--+@nZcKoW5jksbdLLyTKbCCi^77@yK^uLukA{N-L1 zI%uCdYSD-%y3o7Wn?fE;Bc6VJG(Y<>>~7L&Y>|#Uj+k@+BAJmp3$iuq*o4hY2^uYs;FLQn!{ty0bBKYdwzDd(*giV{|@Vn%c zeAzfkmWruULN}?fRrX=V{YISsXyC$*dZ6&LicA8?GZ8$z9D4zIJnjQL{CHjxYSU4A z_^*YX08wR(mprxdZ+g%nmZWG2bgIE!lul_9b!e~f15X1#VEk}#bd-E_l$m*AzPb0l z>yiV4I+t+%6{qO5CitO3y0X%v&>K8XL~2jrn7wavW-}ReNR9SI>iGYmgv-^%aj0MW zIm>Eu8yr^iU(+#b@XuSCUxsS%-y6rOxzB^gV#k}gdBHK#YPx69Z*#ThG(C8b_mfw5 zk3WI>W>qWMB{uZ$8Skt0Xcvpazt-B37fleQ5n9`H*sDJ#zDNb$dOa0xkLQ2&PU(FP zAGk-rF|GyIZC-8XjbZ|)@g8Y!12^5sj;vBa-tIoV*S#aq6{A$l!Umv6Qr*bl?nS>e z)H&<5A`h&1px{arxTiYK_r5IZ+cJyW$oPL_A5}kt)0566aABvP~)nfhYCs;_UF84*Xif))Q!_ z!jox6>xkEAA}W-&G0u}%My;k{hs8GC6VZN6fjX}*d7+)uyT~$(V0YR){^LiycZ~g} zP}fhy5osI!l7XmyN_a+`HH-Mskj;f1_E6xnZQ$*G><=U=tE*It`kDCLvD@I2!#{?b zQlSe}UaU@E5ko!5?7h+_?8pmj4L_a{fX+0t{)$W$bv2!Z;qBL8FZ0!!ZiBCEJBc(H z!r+h6`sFp@FG&fjqqcLAPc7rn&CEtzOJgtf9sa1px_V0q{`0r;yRcZ;>+i+&&$DiV zOWbI*qg|mNJt&KCb4Ole>)5699((crP%OV2IOdlv^$Qo|Esv8N=D{&Huq(n0=gr(m z3;u)aY|g}5>pub)C2DcH!oG)moA1L$5HdgbtGjJlktg;1sQRxL`odX;N1I=vH&j&o zrR_$$)bm>OFJEFEYl91_)G_KmQx*fIGJ^;m9Kt`tyVU-p1CZdK?+{Ec=bY*?S=Qute1UL9P+ zzION0732e*_(WL2YuWxk(jVgUhf6I?E#MeylF{e<;2ghdb;Z4XO(k>+?<#?J!i6U2 zx4>VtzSjSFfWJ)p3*5`WKY8I?g{yn#Wi)MG!hT?VJNs=WabF+UOt$55-$Z#KaW>$+ z!?7k=g18U9kNmk~lGulVX0<{CI>*xO!&6WHBLBCbnGyz`$JOv8=M26nY2{(M4nIWl?vF@1;!ph!o&>5n_(?*oIG%lY zo@AQBH~Ys@oN%?HhI5XUqqr9{o6UZFRYV$ZG&kO$QeHeo(U&WI$Zpr6lN2>ToW9`z2$ zEAZF6vuO{ca$xGFhqXZ=$!bgpq7t~ba7Rf>Ns zn#T8rUK8q(6kg^oD?=0U4GMw0l{!Ej2c)ze>sKoYfm1DDFcr^yEMPEjPD&!cTxLJ#=wR<+5RrdarG9gi(`f7DM+C6UxRp?yQ+BHqGZo_HLh z*?9x|2grY8Dumx&<~19hho8FR`bhRNKEL4}$r7{!=hVMrFEfV@<=7qLhxT7vaZe$+ zi0|dL=B1y+z5r4JKTNowW3Z)fMz1pM45Xuz>$|`}b2q|KfitpcaDbDiuWh5W(MHFqL~#qTNz- z;ytc*f}@Np@&chtGM_4~QOn2v5Jw933xTs1qaH8ZX~a4LQOmf4;H2{jm+r}qVLZ5| zDScfAmzA6l4FZ3>jVcJ^2jA(9(D?q?k9sW^(rZDupD%M%%6{PHZYs4Z8|Y%``zRA> zao-b8i-eu1H~Sr8ThEI+yYmK#yjQ?+dN&Jy_bp-{GK)hmgpXmoejv(!cLjc*e7NY# zUFeWJU)nb@&(GiX$h!3coLik5tndWf&6VA%g8408%}~zv82uk;z%QJF{{9w5--z=w z{>6sZqW^fQFN+<=_twR3*9boYFX{enGYJ7tf1OmCzJ_(RLlORi;3tb}qNQ21Kihf2 z@f3_hzmlDoE#UVCT@Bi0Nz79>0*R~W$3+6NF9aAzLOs1!JovqV_sO%#@zBvP3hcAG z2aY>Atkvg?`!sR()6xU~WZ2tp%OX#2|CzBKTy5rPlJyjP#QQ0^om2te+aDDiVSsp$ zsBdN$^ZfCb%zSf<+eFDw3n$F?YrWrFnWPaP>b=P7$NYY?I6B#l>ySPF!KbN-=k~eu z?e87bK^#BuQuih5w(gnOp8BvCm%P~WZARUeb$fr?dwg~Z4rRo+-?tI_!Rk8VPPWR2 zo)<9hN6kZA#9>Dm)BGGUjvFp#uq1v%oV9W5r5JRj)X+l(lRrN^!UFZRizeVsYp2GP?i{@3FSeI2w>?bXNx~W3(p|9|3qiL@{S85=> zHP?0}LfpRXnNuQQ436>ENMFYNc6oo)+OywQWZ%V9V9&SK=GS)O!GruikL)jkT|Y); zdKH|+9$KMw4RN>fX1BHpxUwu&aXAv7EpL2_bZJH%4r$ihRd7^xgEw;x&ac(D@;2rJ z^ofq3sl9y1g|jYv+=$Ol1n%tYeu96K^j{k_TQ@ISi>Vi$)v_C!adC%rq3;#fe%&n0ugrA~)n=(F)?>$vi zmJvbzmM2@dSQz=a!Kjf-d;Bx%M%Et)e!8T&?|ck6hOE`=?^W2*7^>7zM{oV4atWWW zOzz~^;JQC27c9!4yJ?qd_iZ3wm^8at_Y8SKui0q#c|6aLQ+glw_5tzc2?>lvy9w(> z$)!SXkup{Bxm>9OL3%FwHrC^yAb>^~>ka_uePf;iX!KI>BTGS$Fh@-0$eh zhtO+|ZA{Fh#etW6O+0BHqh66mYGQAkQ9fr9x&&^krXt+Bf!}!~ zRbQe`V+Nh(`AWIieT-uo-(SJys6*#wQfDZ^eXgy{hTlV-(k$vs^`L`tJ*2|bl%@h z%nL=Hp?3MWdn)``_p<0t7W{gj+3dSw=o3Cdx74QKkMyF&=rMm{B3)WZp)#r-(-zIe&N-Aiq$@ubcJ`{`73$ZHw2? zjiir;ox$I))@Fykt%1&#xNw^S_iq+@VADe%^T>Fi@JK22L*Abnd+U4e-Vu8nxruz} zIHQ9f;uXE+BZ7tK*ZpnjjofHgQ^S(&D9qDahSX6c%Bc5nUmSXM4)f4grm^D$=6ROa zTo@1P(Pnkpa$sKsJ?D+1*O1Sno@T4V?>AJ<3Ee?^92GNh>w!OU67%gTltMnl&C59) z_W0k#U}vBj;?H5tAtTsPpUX6~C9uaL8xE8EU}p~m(`WjfK|MTccCe8Q>NIQxdtbwz z3pKeP{RzMCr^3t{e+%_Fto+xTz`1+UH5sJG$JQa=FR@U087=QM}CWo2OVh8@4z z!F|CSe%ZQ6@2e*f{JmoL&PFftN{!b>23|PG9J29UAH55|OJla}=7W6DIp%w7_pqPn zujX?-PvJM^UQZVn?Cm%D+-L%RTJm=hBM0iOjQ>cD-EYEv0v3OlZw;b;eO}^2HS~}Y z!A7&C|G?GPc6X$iP=~Hl_K2JV>&`dNe-mZ{pObx;^gRk)?ZZ-IE%>T!?cZf?)K6P^ zT<-k{e{J~d?b!_Y^Eb9%u93jMzsM1?T4IHN>smEyK|2PfJYMNA1s}D!EQg~V+^%a= z$3%d;w(cK(7mx9IM<|Uk2|9xlXWU9M+TUt>^&~!b6|N-^Cm=638WX=i3VGA(d8vEj zc{05 z9|LDKc*!O5ArJaRfsjfF^-LCIabw_51Af6a3UctBI$2III8BjEOf?4mBdWJi_N)r~ zU2HUy%D%yVseD${b@=;|YFh9y=uE8l4D!E2r@GQCtjR(J-R+&LR~Gtfft8AHfERq# zrX^U(h;hw8|g!Uh>K4Xflw--DY~OxQGd(0}a) z12Y5Y&o)o)gPkOZ!w65%YQW#W)tzy)#yC~e`gnvJ{T1i^lkzj>_t>o~{(a~d%5#3q z#OP0QP4kQGk6>S%LkH&)QUAtg{gM#8RXkL2f8-&~Cswq)gYUarkk0p{U_M0aTIb?O z);qCr1K+1O5WaR5{aVtv>v|IX_j-H5B>-HcGgtu;E7V`yB9+JTl2w> zL=u6PXb-XW)@DWUp$bD@^%F6~S(Zn1CNMrqH8kDM;`zjjj8({d5y!X%jyBI@92XtZ zI0OIn!**DV@;m&~E8=x-9DAsDB3{0P{hhzn-VDE19!qKyE)4r@ts0zO%B5 z_31=1kt2lApI)Vy-bS2xDJ!<51#xqZeR}=g`!9lTiaC6T{Uk28)l+xJd)|H|E>=NL zxcd7%rvm&`O6d*Za`-dn_MCAG#MjKKV)hfT(|n`?Oq$@R)QH%e;r&<-$(1fxx(mA@ zbWmBD0(M)vtJ9Jj`$)tVPS@i1ysU0;EGR&4$lXdf3thpbbwGkx6S~9hkZGv}^oB#J z9{ir*98aqce(-;C|9-IyrD2_zqR!bG_`$jk+AA;NpY1-=)f@sR{URx%Txf+}QP-g+ z_!0FWb$UL%;3UZu<;*t3;j|Tu{rkRv-+13KUg^Vg^n^-1M7v!&ab22? z@>r}K-I5R$3OfTh2P%JA@p8{j#$Yu<#rVN$6JS;Q3J0;WNjV2jC^6F z(D;I#4(i+E%Z=YaC;D|zdE62D(rcqLjUTz4WxgmKj>_yAX$RlfjOMiE@}rJF zTy@|y@_bj1=5KyM-fwg8T0j(d>X#kQ2|nDH!QmSJJ6JdQeBZxo%+Sy3TLT(6pzO_*3VXLD81jf+6NYeidNkTuXx*MYL1OL}ok_`WZyy3Hq&r}Wge#fC< z-~aZbUf#Z7HVFEL_?@`+=V;Fvo@AXd@XrmxAB@f5BPqr|)QaBFHEKUk)`F7%Tq;GcFio)8MhQJMj{J=-;Z*`|cayVGriCGq3{5s1#g{r z861x9sp?(7n~U$!-;WVEnS;MySbji&`NQHkm8yjCWl*KGRFn$NXQ4guXc+h9c7N=_ z3gQ*>->X4w`2UH{bANEXcPbpF1sInGPd|@$vSU3j#gV_GGw@sIM4x;dg8e*}^``p^ z?Cz`H$X}T6#2vw(I^eG!T`jyN8V-G7_*8UU2-YoS2t3G+Lmr3Iq)H5SFv5NO?gakt z*Y{q3Wq$*V!?Z+6%Dr3#D$CTCnb` zQdPC30rlWFZJi~1pjU0MYZ^^}Q+yf1s)tcO!#cX#--`9^gkt-tx{)`Nncxy2LA@GX zya10n>ifw9W*1Yiz7uc5tHXG8fAK}havAO9&o2~%{>_{S@*GY;ToPS#WlslZP-M!C z!~J~BqZBzNiu(L_tt~BF(2ajrvyGr#c)NAd?t`zU1K!(eFrglzPC!u}e1%=H`#Q^@ z(>P8Zv4(w2d(9W&F9|&g>oI%NW^dsR*lop) z`H!^lKZ6%sPKD!pIyOq23o3{=+a_IHtPuydy$uqBolN}4ZlxQE^B50k3&Za`Ve|N6 z{{()T@Y($hf+GV`c+S3DO@`wL#v8>RDZgQa9e$oWR|ojqi;-WS}WR zzDcwCT2}+|j1S)`-Bto$(c69fLxFmo{&&S!ocDvP5RA~WU>$3srzx8te&1NMCr}tV zfnw6J75F)WL)-t&(}0gObs9;aU$GAE8%jVOb&T*O{{zUE#V~09TE%rPTw7!@vcsRUe&`rDWCcGZ-Al%) z1};?*eBz9L`4J_vKSC7s(hG|2`RF&#u1`kf@Y~UGyjP^qPfpGXCG_y8fg5kqxvrr8 zhJ;1&G5Y!b8$WgzCiuTz1KKl(P-nL5{J50?^MXb1Mlrat|I3pJum8XY|3#dSgATO6 zHfMoz80++2#-Cb)zSK@=&$ESgtxY6cx(yyBd${!IJ}v6~dwcnp;O8}{X4J*u&&SIs zC;Cr8KjEV|v4VDABqvm#B|x2(Fk5{gbj6}6Iez{Y?00XRXSs%BNksjIGXAb0)?p}y z{NNCEV!#X|*7yBV)2ukRS07eteMcUgnR_F{8k{MAc=C)J#?ddTeRKEGA4-|+l{1{s zPaG5{P9d-(qi6OJQGh4f!;@eCMSqGe+7wM=e6PK#Us=X6^KeAK!3fx&4;>s; zw=s?>C7emnum4CdzEpgK_XkQCx634fBPs_21;AaUT|*U@aGtyYabhbthSD@v@aP4M zi}~8)%4d>x8XEiYI=R+l@ zZ{l-^c^5Ut<#Df=aUVSA>9G91=m%)u1J(nf_i+EI_9BllUc2LMsiq%;<0#eTUgd(% zvZg(R%3(K@JlJo+?(T^2*>Ipeyz-O-f4kv(`V^w)F%Em}!*0i)#L@PgMl+s|PM+5_ zNf+_1%oDFcv~P{5Ns1vj#h!JJDhK|gcDD1-%sBL=F4m)QW3c-jzw!z5kuNjYsyk+b zd`m#$N)7B>#0dq0?tOdlY0o=D*lh*kSS>s9CiW6E!5i;?en?AmWU2^}Dn=J&XUsueR$OB!@g=>R*1-gdj!?Pb< zD)GJ#!3tJlaMo}B@y5<()MMinSvz@7Ll&Q787>q(TY&DNn@>@G7Q~2Q(r5Nd=-nS&8R=lX=W6a1F!9TPvqGG_ni*l{Vsh3^=HGUs$_@KDB=z&iXF#`ldb~@zS{uJlASL%$1N*g({foW? zeT(Sx?yGZn&X$=liXL1qCoJja@D|438-lb~XfF#&ndsMO-!uMK0uMs}h-$sWzPGFuq=NFofg(M`XBn_@85) zgO82(WANIs=dbzXDNz5GDe?S0>dVfMOI73`&-=I_yS@d_dG+(~^r?H$Nq;KyWh!GH zJ-$)3v>zN~%hvd15`N$qwfnO^_&fdo)@N$4POWz4w-o04#%Ps@X$tg(bv=u{dX*=2 zO-vtOBHlD!ds+JeaoVJ`Vha8*O0!Hi{TbI8jLuF3ue_VN=YPuzdT(`j0oipte<Ik>~S}y7!TmKp9*WmYc_0zwn zqn{H`Q2ue-tM7l3w-594Iy28@S)frCXjdSQZYvEVR-`UWBtKySGLUx1jzUF3rbJ_7 zE(h$6???V`m*AYB-FxH}%e#xKt5GM^c4l55*IBwL;raM8>bL$|{&5=lA?jxz^W^@6 zU-{}w+ysA0%r4S=K^2@yVoVok1nx9ZO4Y-2)fQ4q8lat`D-|nZnBljsOEk$HK)xvC zy8RZoYRc;GdjfFCa{tTG&U5hB*T$aMo5KH{@@qZ^PI91Rn+l1Cu9r0NfeHR&O)68* z>;dvbH|~`L2157vHvJ^>7S0zkaBcO1e$*<-+vSgT9Ux&6fnOe4w!R!3hH<&=Ey4c~ z`pOxSFe-4Wi~~=v6a3e3l3tf6uEX*vK$_NLxR_+u5{{A7CQaZd9u`Y|qk`5Yzr z#)kRh_HU6BJS5@nu}=`sJ=9DX%MPAuW|t0)M0*az4K*#|vls1hcOy77<*t z(I4U$d_JMwT%-k#iGi>FSrxDlMS_ntXZ@Pd?lY`1Gs!rf+47KVLi?Au%=x-J1Ai@< z(NLp*{S)SS-7&89{i3w4fPaK{|K+`MLBEo6iX8I>pZ=tGc#m;$#ekS29R1rAA$-33 z7S;`xSI>uF9(-rGQp*OO;!ukI@K6l8kmJpC349j(D_pr_jC@7z z&f>0I#XLMZz7a*i0ehp=7M}JO`@$V3oNWAoJo;x>UpM4gw@0S#2KHgSWROci75XXv ziz3wsE8-z0m7OGvo4E&f&z-@z2a0RQnV?W|ey)eO3EZYo-2G0U12iWt2h5F9%K#P8RL4i ziQ^>mS0i)8^QI-)MXUJ!R2qq;=NX)L+2C;!9XQ2Due*UgrUUEQP$Rt~fBK$MKe&?fv;5wd1 zO2MSMHGU+mz28*VXa?ychw-&iLY z#s7zW-be23%cR4ltVUIjy0ZBO@tZjR$c8UdSPSxiR)Mqf;Iim_3C(+XDA!XA2QA=_ z*~r(mbC;l(XdSXQ1IKWAY<+(S|LfW8ZE_WPx3ae^YjxNcb@Pg2cn~;BDzkw@bbIgn z?~eF`yL!x&xLlD}yrCKJb#H&qO@lK2Lex)rkIhZ;`eR?J9l8opcV`*q;;HBs)VY@@ z_FNoCUQTN%_3SV3kdr5gz$xfg>94uyl^OB7J}NVt;H(Q}PgwX+-&MNxN9HD}v&`S! z%HdK1)Tdu^Pq)YKN;*|!mL32P(j{ej;J&MZ<_O!NLy_GKF!>>bx-CaDvAukv%&R1M zF60~ae9G@T%0l1z8gRV``r6=zh`&7avV=_Mj}G9B=aWxs$JU@*x~Sck20vOSP|!Jp zQy*Pel70+uS-{HzC{0Kx7C`NpuIenLbv3{!CiFKl0^LJdKKkUT1 zVWuk~=Kp|4VUsrOMYa_eiTxL>OL}RTx$+)$7OKQtWL2okw4&Ib0zMi!o#pt}64xW) zo7%>6Ji3J9 z+<)PJ7o(R&d>0a+K|a=qe98TucjwokL)`QCTw{d}*C`#~CkGx)3)-Q= z^+&o_*Ao1oBT^k&-g{5`_R`@H5!iuisnZQ_`B6ugBbRmK5P0gANYue?==@!$?xszH zbKdCRl%Bx)CaG5sw!Xs7`9({7E`i@rITYpzI~Fc6Ypw+QmSNngDG2|kdiU7+F7%kd zq~xFn@RM}X+J{Tv-!dG}97{yKObHFyas>R&7W1U3FE4ZwM>1DO_^Hyk^=D=9&&yLO zKL+&?zxvzUUWL8S75DJ+@kD;lb!9jM_BBSNQ>q32$mC(4@0C>KOFr|n)WZ)ABpJIB2> zTtB?$#^Tn6x;^d^5cco@XQ_-){g{6N{u+GEJ(-StQ{1&a&Q#>H#=gIq!1^&mIz2BX zaMuBn2*yR^`IG~WL|%uEL4R2HqNOeBc)}ZRTt&Qo=vc9QNGAF%;Q4d}?t47FE&R1N z^aIA;F=JimC0^7v9N>e3z$5S8i{Sh+fs}Fh??chLR4+9Ummlr^nGSzSy)Y{-4;>@v z9{W?pIOK`-9?YlV`s{&kD2dQ6?>xxLi-N%|KZO={1CZAW%Dm$XeLy+Fjp_zCie6jx zLvK9dgOH-*<2b&*AULdqqtV591~a8)(|wIMj_xsy$PDg0elM-tZ>c*DP<+fhIae%2^} zRs;Qfm~A-uIuq(^KCYGtKo9vKzW(Xgan#M_hiAmlBEMNtu5ghYT#`H3n@<4#E_6J3 zju`iKBd#!z2)dV%nDPsJE;Z>@t)T)R2FsW0bKrg-bO#op{U|xzbL$Pk56#M71FnHv zM2N4EqkUg7mUt3zp*=cNSG1rH+L}rfJED$?f!Cc#8tWdc_Fb{;#eGbA%N%36g!#Sb zwfYC&&ry5i%j<{nNuS*41dO ze&Ffy=3iAic#6JGp&C;u9$as-<>l$;R#;X zx8d@@-=AJJy8PT9ao*9K>}@aTq_T3+eRvM0cXI)zS{P@fOZTL~Rd+<`%_PAg?qW@5 zWqNz<@e zdDTDq?N`BB%^sX9-OvHs)f{dqHflaj%BGU{u%SX=|{_Gy??{{+3% zr{u}rKFJv^#;Mnupxf=1NbHBbTy6RExZySUSR{pH@Flpbu}I+p=C_4iDp3aXJ{J$y zic$1K^2x}hD_5XnMgCWR0`2^hFR!&w0rgiT@)_0Fu|CK#OaC$2b(v5itoCurJSqy>~tQ!??$O5C1@1=Q+v5jtT5^=Dga1H0q@so!3Pqp+Ce6J~vQ- zA6scw+ciX7x;QjbZVr9Gs>;*`_P<`6ihT&j^)aTm@!%rj3A&~N{NB>7{`2f2xGoQ` zoUI`CJ&4uhF5v}NeOEa)#f*BLn+da=;H*rZ8zl=2Sm)QoUzY$bD-nqf8-$-Ny4rC2 z)iu;xg@y*1!T-+qyU^#kLEpMfzbxdB{WeZ3idRGqxHG-Z11q%{p@gO zZyV}$`sbQ8z95gJuCDQ@4)u0J7-e8 zLc1NXRybIVx_;fSRN0N-f@|&yM181(&;HWLya+u{F3N)!I!=LK8c%pib_#G zUQOEfy%qekaf)-=4*yqHS-9Z{y3!x6ofY_Ld*jOs-@#AY4>-!wZ{mG5 z+N>-m09@h!+c>FpZ*XJAOef|zyu|Ck@lK}2wYq@x`2fCH8o#w?@@LX`$u#plt zjYWhvgm4So^3?eB{5st=wX$MFh#hh7zq0@v<*Qykf=Ys>zpjCQXlQaw(!H%pzJ2 zJw)DcVRzCneUD%EiR{&BwLL2{`w!Q9Pwc7@oR805C<0T!YK@a}}w0(}oSxc};h#Z&mKG?&(`Gzy**>g3Fw17C3ZolE0Hy&H3^ zC7m(ai90bo5xOEv-s8?DaB-?z<=Q6_aA}`NvLMEVh`gZq-u}eCKkptsB!TwW4K>^2 ztnwzlMbCBEAJzP?PGhid;oD4^?WikQxIZo31HUGCuCsU?^LyOxt4kX=E5SNr>J9XV zV}Bidt;XT7;H@m2_Y*ooahEkEP;%)SV`cz`@>K5f$l%)5|Nr=NOZ-iZk& z3!C9sv{hd=Ac;DE&Ss1M{^55CH9V6lVdv$gT5{nxUHo*V#bJkZuT#_0c0$(>x5_6a z!n~H!=y2tRj%Vyhriu3dvOw7o1bZR&zR=1>4|Rw72X87}!1(fw2y=s8#b$NCTVfme z9ctRAU;B_JSQi{q2Opj`{9nE|)U<*H~`FONu8vOJr zUcyENc{HicSK?W)!~Ymx+6=bgJ$u3*a@CPX^KXAW$b|E#wXMF;QG!=JcfM)~K))xu z5o4~1c-_JFge2_!1(SvT5ctV4i!4816X-xaOU1E>`_FN^ovMHz884*?2;TEg8_D(b zkKq^ON>yFMP}dZA{n{qDWG)G=RBX+^PKCtrPP$KJ4D$i zeoi*AQOEUbvR%gONYq_h2e$l3vQhl+SnhehQt+(L6$@Ng&-;^~C!ylP__wfze?okB z9pE@fT8Mf1;9hVTcG7dHb!vMVyr5Hr;8-7Ym7@d(C9lE%#=e}%^Mr0Qq2Fg=3Z17x ziewez+Ijqn*8%k3QaSt0UOkG?NEN4;FYZ&N`i3+LI-%*C2C3)BgK@SA)=}90o1^i&Fs}9jcItH;F_2%$>!{-(LW?=Bp;sf#2in5>*ng7ahN0mpSk= zPSKTuCjr>!m>_)D1<#?8$&Xw1Mmr-3olL<8LK3+$3^6a?L;DPKfMgd1Gzn}Hp;Fm0=qJ4Ry(AB11k)0L-U#b;%ZUqlJ`9P9PogMfu;1EB< z487;+x&`48F&=4`6Ve#K$475Yo}~tV z(i9!9J&5&U1Mb2<9`*r=Z5490tG!1)7l z4D>9ICu&k&XxC9A&As(Ms_e;#D14;7jB=BgTSWSMk!|SszX9nzEJ2SDo^B_Xt1YPj(69{=Qu9kVb{fj=#34xYn! znmhDzC6l1ODPZR8N7%RMC~>1w1M=gN1s;vib$JMxZQMR#-$!5km(p?QjEU(zDYTg1 z(>$T|s<11G;?n+y;GZYrGGC@Z&kxfw&niJ2x&HOhUGS{g?(-}rxK_8ys!WuF7xt=^ z-bVl91ld~}(cfOX=pTFgVvVvbjnkjN{%!887Tg0*joqa!gJ1C6wV+`*gSb<7g_1=c zJgf52P7cQToO_(gNyNj&T)&f}b>OYBe_j70!?{3#1myuHsPpYR{N-W=>P>&TbDf<< zzM{tQ?2kQOk;OTb0^W2{WW~?N7P`&w`MZ_Qh_{i=r2EpKZ+$w%|EmV)Gnx^G<^lgM z6EPDUO-7#3N0gh`4tcQc(@H&;P``5Oba>-M;Dx-w$z|{={R;=uxe?Frr}%!ofP6)^ z;gz~VTwg8=rj_ISgVjy%k`Rwsn)LoWL_Cg3N%|0u-`y9P4%s^wM>{>B-ct$nQS-41 zd+&1`x=cygg#HYxkzdjzL0q?LxS7q0eBB7oAr=+jN36`U74E-pq2!{s6Y7?jOE`wS zP(Kr3st^V|Gj3HAzXAQqc!h~Y2)G+>dSP1@xcl8YR_;Or>27siW$$DgKF^T5AS z15Y~tgs$;Wv|v&x66YZa*%7G6qmKEL;v+KfEnW%XxJdl|>l?8ya`3D}+<}S)wfH>4 z9q_pW?PL|z@|%Gkwo95JNQr%P8Lzayqy8$#*u>c!b>uh0PUlmBN5v3K-`j>xb%RDs zxf8r4&X%^30=O*n`eWc1UA&)9%8D_^9{IOn=^Ba0sGq8g(Q0x)-Ba(a?lgVm10CKR zk(9*w@&hb(Y|xv`=|Y&o!HbRz(f=br-ilG*vxJQWIB!U#kbwJ-#&#W)2Vc5jA5+J@ z1Af9cOBV^gVEZ7Ic)SOE)m5?Ea|nDkkNZdmbSJ_M+7WVE@IUk7^zXyc~AKKyZ>M0lu~-OMAVSw=pM zRNmzucxA5t>&+mHZ+%1FPqInyE1B7r{;#mhnHbFl3VTIfG0NzZS1}Gr+Nt8MsPlLF zn!^a5HDbi?8Yc|>&p(cuaTDtqK84|?Oq@%iaQeE|RgCk8P@4oE>_dI_NoFr!mUI4x z>(~zB55u$**%Wl{F!6Vp1BheiggUQ6?~#aJk;)xK{7fCJaBoE2h~Ue|lQiHleW!cB zgEz9}U5_!sxXx{*M!nyKpEo8MGGje(?ZThmK98aQj^yU;?az$VzRXIFYq0h2blWT7 ztxY3;r3s+R9nH5>%|V=LRpmB7{Nz<_b+dR3{2QP56hmD89r2}~aR&K@$&e^v2KXCg zLG@v2)WaP*XCDp!-%2(A7LR^8S@Cf1opW*S25BfUEA-21;vW5ZtlNK13VcGGALn!k z+ly~Q+9As#`p_+i7FP>}u`kYhB1?@B_`V)o^Z@yR+y64?=-wl5P!@fS%P9|6?hE3j5R8d$>=EAg&rL-R;rDzQ}I+pFF^)ix#d< zbcmDPXD*#h!1EMUJ{OV$7n8#ooveWeRM8|)dw~-c{^Nhnpx<2_m*XAJ3Dw&gsx1zFf9z!o5Q5SH9T($U7;S%0+ zb3uZZRRHxK&w1~>umLWO|Mz|h<1go2R%HV_=v^B8SV{?9(EPy}H)@Qtb;94S73gky z;k+I-;7k7*(s=|;#n(ghVktSc_9i&P(j zez39skP#c^g+8>_h8=t?<9vA=7xb!sj3ayJlp3#HDAUC6!@9NEOJElo#8c~IlHf-~ zG#W0?WQ(D{_V>NbKe&A+l=T1NY?NECAKGD9D0%P&g+Z{vu`b$`qUJ3rJ#`RoGt zeoWkBLQn8rj^B=4!281!RLar7e~$oyA(2efSB@R*BMgR)*v4v8oo5Gf_+g(eiyE86xNf>CQC-FS*6q)YGz)@mSz2^Z3-c2b*|+Lhgnn%no7jH< zuM46!e~Ign!#RH>D={u_yJEB9hdfnXy(MokZ&}&5olC*CE-Ku=FqY1q2UMVf_CCsmpz}ZkTJm0^Scg!8U$B|fXwFZ3U>HcK7 zf}7yw(+9s_QUfpC{gM2U6MEIlqs5)5r|M>jXv#!BweH@nmzUwsmPeVBON(q28LV^2 zhu{YvZd`siI*a`I-NTck7)Q&IWU(q)@TyCnY!kqPTwgZbE`eQ1(O>#49EEvvN?Hv^ zzmMo>u>`?xncv*)*a9!q;q-M}fgf;X+`c^l`@NLHAS4GK>KUA2e9vZYpJQXX0`3=b zk4>>w9eK_wg2_WCVdq30X&zW_KD*s4(u zT$^Ru_{?*zkbQom!pAQkpT8u8_q)Te<)#1|PM#Z-C3@spWu zCQ)byIgJ-L7jSbQn=GR;^oa7UsFKTXeIKeml!Yao$qjClStnVc);Xm_5RN!L9>-oDYyc z%RSxnIvzY_@K+q0DD;uHf9?Jqh3=!slgs`Q`M3P;Z(r$=4}57V`g02WN@u)lAQZUW zZAnsIX9C_NqVmTT`qoDo3QAXc=v^8U979WJ&+rdwrE%y#nszz)%V>wtGIJ*Ie@*M4 zMiqEgxpw@RGWb;vZNv^C@RzNFjCyVudCZCrizLwBz8#4VpoLxRzs@JuGKKN+OwiH; zKhi9fpuY;-ez)I4_y?|c<#fkKz@Ns5Uhc@Eo=nieK;s$oIWD2@%g?c2@t`Kp)*SMo z!_uc1r_s-IK}Uo*!85t*rvf_qf`wHG+rH ztRLAsSK$#a>4PVO;Q1mmhdVwXALv37QsafZ9#8t<#s%cJdXG%7Yk?=6Yh}&654&14 z8UE!5zQkM4Bnms^xzNEJW43qhe$#t)@U8DQ-}c>)+Ox|XLh1_MVWLaG!=n@1 z9r_V%hJM@BoA*wb+bd46QS{Sco+JgN%a5aVTWdC+0nX`20e=bo&k?AyUQX_S*0XMW|o^ZXsw+fLT}d%DAH7LCmsc*afA=|A#YaKOCv?+&dt*1^p-3Nye*F10JKFJs+LUidxJqaE+lOWEQcFGf9+ zR<_s78=Pa5IxAF(^(|$+`sobtt_~jit^=ssXt4>i>V&SbIzUFJ#U|$ zAOk+!U%Q&VdKY{z>HgZhCUlp7%`RKO&FGGi(PtwziV+0OGRi5?Cv^OtL|EXxaeN=Y z>R!bAd7Xpgf9s&$YKCRP8M;+wT>2SWWisyDJ zSsAgv-%zmM)D(5SmQn0AG7>n?qa$pa#}zzep!2V^5T%*ZM5K1i*5 z`Sy%h$K}qFD$pTsEoahndK2|%rM#4h-Ow>Uji_W5p)Sfp;?71a@`uaHC+smEA#5h} z?wHqa%1(K1z@G&a=^n=YgEe~h?X=-aXx^#x73TvD9%;||3_GOItIPuaUoPP~ulEM` zTTY*7D?{FdQ*PtKC)lT`5gTYMjk-KRc ztL68hAKAQk@)z@9z*Z}5fpNZATlVNSt`9alx_8W=-@GvxExHQ5V|gr`;Vf`%bW+9w zI7izv?O%XvVby9!;%Vf==|-hH#ekn4-wKZM!5&vcP2+GCV^K=^B#ydyR`#nWl%bcp z-?A3H48CqG`a|qG_(RYA-P3 zH`AW~*HQ=cT+fETRj@Osgl{*E{$bo7|Mzl)5cbug!0_%n^3qic--=)_>9voALY{#? z1!pK$pnV0QHy&%@`E}P!nS{VQ3wP@i9o@kXh2K)XGJ(G}S+PoEzU-6wdCn0+XXKjy zBHsu7>RNkHN;%$#{%}U8DG&QG`VQ@DfuDc5Sogph`jzClO`dWJ%+CgG={_FlYDWIG zALU?Y%5-N+;lE9P-x+pcTv;wkzvFxizNgTB&K=KZXvx^l_eZ;`mW5l;zGsb<#S+fY zowM}lt4+aEElwZZLHu!Z^&6*CL7l)uNxKu^RV>qzVoXvPmoRy{!?1(cG5OQ%Xg}?3 zh0MSw$g__M5PXI|G~MuRD&599=AmRr9m<6527^i zEnx%v;NpFi&ed|PclQlBx8wiSy{rzMS_A%Ql#G-Dhv{l37cYZnS$Qzf{%FJccZyl+ zb`JCep`&Ipq2MKdewsW0el1RgN$$N5Zh_JOv|7{aC~(={1kZ8{B*kP<6rPaQCZ^8V;G0~CuNU( zgFY{0*B!eIp6u8bRu5cBp2&@Ui2J|wiDOj(e-a>h`eOz>Y<+fG#?pZf(_1rKR18jr#8+*PkrdW47~sN{6E@VLcEWfzMRt+ zJgJtXt*sioWTCyh%W(j>xohk!1N@gFJ0HS``=9w0JNOcO%r0}-@;`jux@Pdo2E4}d z{jUSRp&PCKy>Vjj9rCA@mMdE=;8}k}7w#{CH%8}%MxotT^z)48kzbq}e;cC--jtbH z=JgKz>Il=t*kKvyXVnRFg&N?C?kiIF6p`Q5VYpWfK6z7Fow^=;Oz1z&9~Hn>FLj2xGO6MyVc;Udq4-bP)ChzKi>IFcWqc(M?4N{yg{Sv1O$Vc;>E-a6kAn zoyaeXbdwAt&nouM zh$jx$Zq?RLVrZvm+K9tD@ab)WyDEzq?}Wy-vUiw=Kl_w|Pk`5?w&|O6L+?}lm2y2A z{5tzF^-ftUbXn05=7&#Fhc7Rz#1A_oAt5ZMVgld$AU04Ad#~uB(U04L&M-t`X|@Jj zs$!aUAH@1oqnkh+xas`Pc5QqFyyx!O@V-f`w=VXSy5aX7jMH~I(I0jd?Ws2CY|@gf z6BgiEB8LT36wqD^W%rAF=dzm2$6M~5kMes#I{Z-x)>o;VrhOLZk9q;?BK*#emM-ZN z{OmQ4W2h8x(w<7YxCU{uBKT3g|5Na+m;4FYHCVsLY>qdeeJTe1g3+|Fv*&i(;m4ql zADbqg7eGGH(ZVy}h@E1(VU;W^cw)2E{F=!t=5*U&H2|%pHK%( z&FdcJI)w9o1YCRHfp45V+U9-=^+yNGK7TleJYXShyO%T0Z(Lrf%y`Ixcso*dl@K^w zdt+_sGjK+$Q+LBUdk-fEpCkddJ{Bw_1mbh$K=*V7^Z=T%@khqMzu}%(Z!xS_2d&Ku zUjqN~sVgN0uAx7JNoT$SXC0T{lowq`zQFKx*P-*!AHx38qyx9>m^U*SkngeFZgp;` z1D|qN&Wv~lzL#~){i%(OVwSNMU#ls2m%ri*)dx5aROPO@Vhq;lK^Fu1z!NoeqO@(0 z2NA2*x%n3R25YT~t0I9P*^O?`tNz$1N?4!saRN_F(7f`S1Gw*GeM^KJ<0b47qVQ_~ z_*6Mcdlh)+n(S`Md=PQUR7RVE1^y!Tt4@OfIxMe=LOdbrQOnL|lq^CoSrrRt01ws^ znTt>T09WUS3ay-dz$OabQu-Y1{N{R0*(?|Xtb|8=&! z7y5;cFp11K^r+p+SWnFBs#T6~8shWc-87r!&&Xqm%T1>M z*Nb&~BMxLi$FStEH%vp`d&W0o9k`!XzsU6+cBJ1RMa+O}<>A?~`Uvm~!^sD=;A1K# zI6xu*e1^-dWUr2_jwV7()(&~8ri<-j7T`}V8~*XYN20`{ycm7lcQ|WsMg#j81-g&X zt3sEQ&U##`1>GTB)5Y~B@INNvW*~4i$bjQjL=fyc%uw7F?NAp|q`i=c{bSm7rzWDn zH-2ndH-M)!dRkY@Bp^uta*TV!v%9)HQE z!}zqZ3T_&MPn3TyHg0-^dCvMznjigSP^$b( zP*rl4AN=5BWrBO;JLoW9mXDD&?(uBbFZ`I_0A<2ku0IiPd?h^-u-;o9kTD{m#yUyZ zJ&GCr{?(NI?&puNQ!Xi!&=`zIaLe&C;4$Qd+J+mU&N(&<$PoFi;{rvI}Q{FzC-G8pqnAv$jK;~ex~_w+tXIpiJZ(tn=;?_>V1f3r;h z{A{U?MDZAO$VQenb$o8oIz&%-dN0qt8}Sx#!oEWJ=N9IftoEj?;1cQ$oL4z&HKFIo zo-mY2#J=Zz$`<)1=srbuynFBGb2|6>NdHIhkW||HQ+3E&+zJQd40nKr%h%Y2{M8AO}5x4aMt&x}9Q1`9ecM5!u+T+t1HsHW5msnZg!~3^< zk8BQscR4;6_CtHtm=~IeF5}$Dch!R~*2rtlev$h41pCsu+l4K_uVUuSbob8xVeQSI zYQ%GNJ&3BG1GnF>rk7~q%KYZazutW8Cy1yUy8>P4(hqW0wh7dYNjI`hEQ7Zdm0a6< z&!Ph3ij~P2^dpbIEIGj8wz8A&fAZiw1(TAyE?USRp7~_<^(Nkz`!AO#?3TUaev=*g zRn(PB=c`PM;qNy4vx2Ptflnq*rHBlH|7ms#-@v>YC;mE<1U&!u;&~7s_}!BmvqIxP z!54;;^P0e`LQY+)E`*-6`}ow;=`FNZGFjT=EA+$aU}^pe%n!Gj_RAuiZ+^=^ffM&T zZ)3>$X$Adzb?W^n>Z-cSqnISXul$`33(bK~Bx@Xq)q(C7-?Wmgb^-PI?`IV>lD|M@2+E9y6*g@g1=kejH3&RLVp`qnY-Pv z{;|9<{SM=4GP9H2Yze-Xb?W0Z{Aonfg>>GN~@%tv~T%(3w z(=g(BQQU^Th^xMZ{(gSm$WJg(xqU509Dj85*F&@;Gt|hecmjNYnnUaHSH#s%8Y{r(;<6aS_Qey_Sf_X{9iW9> zMz23RZ+8&7ZFvLJ`u@FrqzCEQ5U2ZV#bWk>9}w6FM%=AMKCfBv!eTx6%3b2X81VA7 z8kHS3;JTIFD}QCo&&_^S4QgC@{zdBZmZM!Vg7f0Ij_3}#y8Z{;WX+azdyV-}CpLWW z0(o+BSyqC0=u59J1Pg|N*OBZKI)Hh-RQ2Z9E6nFD%CX~l525#bwmV4&-Yp*A%&dv| zH{$0zHiI#&@ z;SYG37O0%INTSNTEDwARzO5`l4ezI3(}yeH;a8^=~I{36Y*_!jPOV(-zu z(hFX3&Esy@BJ7VyR>KbKy<0|iKCte>e!@Az)_})+Pp7YSe8PB1`V)Rl126rLp7&2I z=KYrX)Q=S8H?NHG-YUfWEt494#JHa2-qseue7U)l3DLvv1$(}bJ_E0rNd0>(g$edR zZD~D2fN_{4?+Ju{%e8WJY6AN?f0q+kSF?aec1yk(xPWm}&dp$Q#(qv~29{mStFM*a zy0<&*V%VEm>>kGR@~^wEF+Y>t|7cZipgrf>cM5e;zs9nEQ{W=_aSBiODOJ>uCQ>Ts z;rVPjV&sOR_&aj9NPZsZX;Y&!#tc|Dd$J&*U zKmV1+?1S;=rZW2dcnkSgznI|(eVjwH8bAFCykO;{_zo}d(%iK9%1y-KUzS>@A`pM0 z&Hk1BZNU2e$sf+Wx_8DQvi=7>z}XRQC!Y zKz)mb{^1uqz!!Vhv;+HaUXek~>3iF-1A(C02Kd81BlR(A#H&vA9O}A@h&Rrb_k!)v zezDQIL?5*OkwABH3f`|McWHh24c7evF}sm3aK8K5i;wnnf$1OO57+SgOYhH5Yvb?k ziP&Yti7*E0aW($xC;LkD&1qxr`Kk#D*xZ*r3b`9`XhiT#>8!0*Hp#r@z>71um7 zLfgQTc9mv|TTnl4Kp_?1i#j}!n8QE8kCRC0nFW3!eri1MyMer)`-hw5p#;d!ZCOk1 zfIqlAjH9^*esZsplkrC;>g^8C%I)T1f1Qh_c`)qdj(20_tH0={PKZb;_?6h~OvweD zx7AYdP(KfKW6ar7#par57s+ljhnzjuH|5v=pni)u#!rBW5dCs(wf>HF|DH7B=s`Y_ z;&sp372M}!^CN3{*qwLL&|g;Yk;h6g%EKPuE2K}ANgkoS^0!F@pf4@@EX1+MV*YRS zy}APXVZCB5kN~^mT)#$sI}E&{Ztdg!8sw7&obCDRu`llT@yuUE&_!SNi}Jt2c@S&a z)Vr{Af&YfLPk|qYZmN;G;{Krl^rDpKz-wA;Lu6r3t$#-412LbHFDAEKE09-|`ucAJ z_X!B*zjZMR=Q>P(W?*+gU3$YlLmKdv?HWH@l0fLGG=+p%q$z%8r_UXPu9kmV-h&i& zT6>39=sfN}aNX0uN(=Ml;_~2$0`}KA&&}KsMjm=MS&&u;`$uKIH9dy^?C=EM7ZHPh zKAaYtBS!vDZ!5;E9qXw8+e?(dA5sQ~-+TK99oc9_;s%f>@lk912fK~CH#&V3{O!Zj zexitu5w7XHUarg}Cc$)g@ z_WgwZa4l1FFAl$-IWK8?3-wo$R{S`CO3^~ZSF|V+anw{;?gwyzJvi8;AI~?o?FwJT zdTwC)JxT2*ctTxn#}wl6S*ll`mca)-gX5MyVEuk?f0(&Q`XJu^FsTY|4SDT@5oTT$%)ZQ4Kb6o0=R`RIs*B!1WC$~p<2ClK~?a^)ZTVZF-s0`^d7 zO(J!w1H4z+cA6dip;miI_N5>CRm6o&XM8U4jQ4Ta<9V*VHCdz3n~a|Q^aU?zVcY7X zn1Ze&HF+izSK+()YwdgA`y3q29|qqYA%A4n4ZaW=`N0~zjUASY%LtW4zI#V<` zF#gIlL4HrNzyoAX>bZcw&3<8UNpV9x6_=GAUXh?E9}?}<>;XN=mBE6-58wO!5+Qkx z^CgvTlf>coAwI+Ff*9|+t#Uzvz?pk`QHspqt;S@2RO-Mp877jY3mBh=rN-e}ACc!v zcy?K-0{qJ(Cx@>Z`V)DZa%wa3bhpPY6ZgU{58nNL3|B+R6YmFb|8X}*y}4xQe?`7^ zqXE!m7&YWCf(M3vD>z4D55BP9{g2gc)DKXTyJs4MAIRT1Edc*bnT`5rS3_Lp0#nI_F^h4d)!VtulrFLtQ6VR#l#mmVA(jkA|JL}wl{hz!AAGb5Gj^eeS zJ@yd#^7AeBv!*1_^<)-ZKPZFO=Ul9Lk&5+VnCi-2{i8+85E9tXld=!+zRCtJ@w#g5 zyMu*ET>~EQ*05#q!>@^0=nufJ|6TBWO96W_Jn*8L5bYS@ z@g4j}5B=x2uI2NCsB2%2S|3GR3>nC`)@MK-=)aYE9{k<5#Oy!~HF#ZCFWDmE$e}04 zxAIP*eu<{(ZM!OPmhx}UMc}|hsdI}z{M<`zfw>U=e?vmWxYj~f(GUWtb z#kWqkS0_zeIy@>9j=DD05VFZ!;Mq+p(gr{?}=9w z1qPX1;Ua1-G3UL^i=oD3r{^ zcTqp1=On5G-t+Lh*h9rt=z(kpb(rwG%{k*M`|_Xz8C4z7%LK2Eax06dhQ5}zb8Kk^ z_7v|$<%)b?XtaX%pV>>J$vtTooy=a z|L3yCeN*HakF(nugn&oBSK{8LME#jG)n7;P7VzJ&pz?9>B+q-6;R@gb6P8+O^_Wi| z(eo6q+qZ}@f7&|_Mo+??&U8kaR%2di-|-bu-UALy@EWLOfG>p}m08IFUk{| zzQG6BFL)-=I2Jtl5lNUrN)mW^?yz`I2-XwM-@KW@qvmL)jud0wUC;Z@rr_@dRZ3zV zz+2`A{~VUm!u|+e#3K>3BloMW;|cJ8?<2DB@tH&O_r{t4a4FqOu^Mq$Z0W+oEPT)Q zC%2RPH0(n2&S?@!@OHkG6D}0Ur*mbfs~ zDfV-W7RAhi@5S!7xUsW>xV@i!F+U3N@vF4=-ah}e^Z9JTSCF4N{dkH9@hoCGE}JSH zJWD_2?g(%~=e5T#$syDgr(S60TtHssn}WUf82FJ#DQ(FfzD17xe2aK^K=Kg|QpCP$ zx)Uze4&Y^S(IdvDh?jw^apqWm9(=@p%M5Y&jD&UVCgOIIO}ZHg;=IMx&fsUX@Dq;J z=vhI`TS5y9~d(-sqjbjrLq}6iq6| zI_ijIwd~`+;48ZVgKyyX2hP*kHG}`LUTsqfj(|RR&!*&o0d$0Owml~$!0Wo9RAFI#UA4}z)p8)kDtYSwqEjQN8TdL$>k92Jt>(?^TavCCF!-dfv^j| zOIhQID%j6kckaLn>`#j0SY$Emk~7BQW4Sc)^RXxW>=1uLb-8IC!k&(s`3~5CKPX?m zXx_hrdaBuIkr42eZogw1x4%HgVEdCv+>Y^)H4o?b3f+K^yW3b_jSN3~@H#McoivI>L7yk+$X(%KGh5V-_9L<@ZSLV(x?E1as~Jn*CEmTB=GP9A0ErVUfK1ZX|4EySLF!Y zmVtgjuR`x~IUasEnv&@KYR@k!cMIyluc$tfeBOfHUp*C`h;f;k`p<1Y#`)z|UC~A0 z3R&7|Ce~%}P=y8YSD0@i9nCe-53onY%4~`E$cM^^UP`G&yR%f6Lcvqk`{Sr0!AniO zr!pDvd6E8_V|*dnCqtILcYf8UL83^54c}Fl~u?{>ZL2GdRm^<{E$mdEw687p7Y{mBC$ve@i^w9>? zxmA_Q%Hz3Jn={l#;C)f=MRbclp})*ZSNqW3ai&9)P4J(^2$8p?m{*q?0)h24@JFAy z=Smx>|1X^^b?pQHIeU`uJk~Si9*M7&LZG{O*(NgkqMni9<98u1*g@5l)EmT=FfBqG zZ;Z1cz3NhP2Ig_nrc%BGekVQUK7;rsWKu79199b@pu#9u0oGA;+E)dfz`J~W*d(-} zPko;H77D*BtQ0n25JZ3by=&zUV;mY~%Qp5yw;Z)>Hljcr(94TXCC2x$fd`E`D=)~sk_(sTJilCt>)*XE5HRGW+Q&AqgulP0?gqz{<>wJX@~G$ z5`x#okJ%6}(|D{kM8MZ93Ma#qp$B~3@Tb#&eR6fz@4aWbagxer9{wI!Ni}AQIJ?Dg zvsdU8bf+NUlIMsI)@9@0d=Ll7Z_kwp2tjvQ({BxgeYgJ?qT~#`^1e|JFaiH$N?})t zLi>0}E|6JZ-Xc4LDdxeuEHYL8qXKV}m@&R%d=>GG;p60jDc+-VqxSXsL+~zBR|*0j z#HFm)27MUcU^&uSjvK(^?G7umyWpksce=bhaSj)!^nRLH=wQcoq>}Q1cV$Tjn9C8j zCSOJ579ft)N`?^?0W$MJ>=z1 zbVauHf{!h9Y0v3)U|pn66LaG$_~mS__?<4`!jK3LQnS*C#g;JO1 z@uNOJJvO}``k21%jZ6DypxgBF<^KHvzVcCY#sd1;v;SOKIX0k&^>rv!m*P3>DVFxm zs7EjE7~hNc5B9YRnIA`-T~qyhiwL?_zXjPc;;HFP;tvDxXZE*5FHa(FlHYPj=z<+& zFmEJ_+{W)C-;M3PXJ=xhl4{Ea&-HpBn(79gV%uTf5{CJ(&7Nt({AijFmWNz|KD1~l zM*^PXBvsonjkwq`kjYbO0zPfk@HIFP`$9Ed3no2-9+vokM=cV5@;po7DDJa=JD=*M zANbLqC|+~ie}25r%)|=%!rRW+2H1@-jrjHF&;i)2n;ngLp+|*!23Ig*J@R|f^$jud z@<+7ZjQ+xVM5NsZuaZM2V-Y(q4F33l+(1+WR{{+M6C>acKjn!|QN-DXG2U)}#Puen z^8v0{S93WZVcI))c;ulKp-v0p##_F0|7qY&yW)lz?0NC{@y-(9jMf~zZ7e1D@jgz{ zevH#68kXb84`z)sBAp6?&1c zhM;$IGV~KIxg+t2<7b6WpCiF%tL*%qI`FQBy#qjH)^G6;%fL~YcyS@Dlam72T$VZzw-YC2*^3xP0=jBlH5>60y{Wz%940w%;%hYC?f>Nx+L#Asy24 zXTZPRwL!*I)QLo8b@T&&ji2(LF#x`Fi>(}|LVvAaueXM$V}4@$yN>`zl-tSj6SBeQ zhU>pb13!s%Cj!n_0%zP?0=a=}zSCtlUB08fjKK8g-g~~MqV|!ci9@dnPwN-c2VWpI z*J-nZf2XO??A41FuZk6pUc)uKYA8hs>j`P`g=>hHTWSw)?qZ#C(@m4-{&}qP#M257 z>Y@&}@W4&+%UECM2C-x#Zl<_!6_R0mhm;oY^J4sFG$gX?MX{bK>e9O^2c0xVw?$48 zb{rk{st4nLg zO8GF@eO;q`(hz=swI(KvLlE)jy52bv*r$HbG^q>vH)8I1Ck5-0qDO;|-U81eJUahU z(_mf6{OnuIU+^Yf*@*YR6O;MSU-o!D+YtNiH{kn+8RnQnyQo*(EXnABT`2HxpP;1& z-}HR7rGV#^8b9n2!~9RG+f>Zq`@!Tes)=pHmBvb{5%9yCiUs5+f!_&BWqeuiFB+QU zS1Xv;KNkl1g<-#OA1uBvVZOTTM5Hy)Ki{lhT05}&nDTGGbzn~l^^YFT9)@0U`JRIW z`sKvOc10M^>%MmQa=;eqkf!aVuJu7zT*?xEQHwn0^t=TUL5gdSH$1N3`p#NHSQq0p zPERVG0)F$nmdrZ78&`gVPCob*7e!^oCp_Qf>u0MT@W6ujwI@H(&K;|;-jA?D*@M>^ z>91oQbgp>Z>J0LF41?7^($KGj)H(ji;eAo5>Q#>5UA@1P={Dfc<%3oJCGh9AI$iFi z7}&8}>-3=<@Hg9dz8@vn_j~u&XcyYmz|rwvLKW~^LL_Oh8slve9PkM3YA@a8VZgY1 zDfh5Fqz3;Ee>oTfJXf81bnQ6i;YQ)=)F}G9Q_^MOR{=X_OU={6_;P%yo6CkjtThbj z4J3lMEZ|isY0#N3u`Dwd*(xr-4{RYoTqEx~Nu2<@Ir?(yvG_;uzI}O*ozfjShBGwqLnA+%H_)Ye@0mAyq5j}{Zo|k9bSb?$%F&F0 zz4ti={o8x5HpM=x?Vr%2#hNAPS)fOA5k~gg<2^^;9&>1Dv4H;-cN$qB9;p7Tu)l

ZHX%|d^^ zyoqt-c||020r4QVy{2^p<8%AVY>){2tkCwUjTpv-dC<}BG~&0bxbfG=z>TS1@3>{) znn7fnd4n+OwJ5#~slu=KOQox%!GG=U50{XfgWh&@GtI&X?KJINzIhA%5*jE@#OLGR zU9OGmA+Ise73vF|$G?N#1)1ab6>haLs+*;-`f69w#GghbcQ ztsm>un0bLc-PM!Yoiz=1`?9s_vi>ag8%WHx@?xFGG+`jStAcUhd(KIYIOMHG?vw%k z^zJ&5jsW6V$J>L4q^~0m9j#K;KzypEv$cC>ycd`3X#;`pAL2Vj!o09gt6#~8660lM zOZSpJ9KSbgvg`DRuJTLr!z~6{ z|H?HWU&fs9nCLnB-E;D6?;GeQ-#f}@>MR<8GsVzlCv=ZeI%d4czX3Q0BY<{O58}80-gsbZhw*hu_QHv|gUT?_7u((r0na z7a4tewi*1wCzCn`?O9v*qK(7vDCPo|bg1yY!y?OJ2As!m-}0XN6nIwQ!Ba!A(6zcB zs#hp&VEml=?auXqABgX5`=teix=rtRkAZAE;& z%P5g`7r6cO{+ySJ9drOnzHZKEcz^ltjX$dS(9ftZR4>E+1&WNkdJ6FzO@-RU42+{w z&c`(HtK&X9#|&=l?FS*t6On-)eBrLzZ`fVjwIdhkHeqK6Jk$?k9rmH!xxM5I;@U}u zE8RW#Ua4_$FF%qHYjNw@BI5dAO*bassG3lZhxyp$Al*^w zq34DN@;G*Zo9u{#AvQJI&%qZ2)&fl!vT(lQOH;sFZ^s$B)x!k5kJ#cIS*dHKEdw@znA=du<{u2 zNhda0*AMfH*U&NT)eVFW5e(0hKo5K|V64xHb>jMhtqJ_o`N83+po^&Qw@P`GFNbwT z@6>!N`sugztScYmA>6>JHxAyy^-bn8H}H|J>c{WM6zFRDepZy=RVgZwY-R9&!ZxR) zgovMV*XE+_5Z6EVJ(%SI-X0aYUb^?*$YaW*sY-LGlWx03PzyX4d?>LIg!``zh1F96 z2S05q5^R)1pUEN4>jwV)xS(Vx_X76~rPg-E_>9p~qlVus_C(iQ5Xe4hoVtg%s&eW`;z<#)ZKl$K`$c! zKE3}Uu_3OeL?#&&9EhK1?xhVNE)Nm=lS_@EA6iN2H_L$Q8#xcg!2=)ZeGePUMEn-L zT(X#t@g%Nb6+^sd({P*L%R>e!chZX-gCAT|IvWH(NPHoiG>-Xb{zuX^1N(1~tR z>)Q@s{(CN8i~1j*HIta(!#o6g`veB#d-3nv1gYQ+ze$V!nWI12H$p!C#Pb_()M&E9 z-iWk{yPo5|b0x0TLBv>}1xvfq;Q!g*(2*D;EC!PMn4@ryZZ4aNs_-N{$KQ9h__^JcVEjiRnl`PcH;{QXf$5KNrQGdRXBf#JV z{Zs7e`WpD)_w7C<@^sk0eH_)^IT|FJ*7~Q>&YPsW!%yEqmkmkPT|*o)TR)^6`UiY} zgwXjDGwSM&zGw6UA7pG$(F?(NUz~FiII#%(+%R=<7(jjeGc)pu2Jkj|jdPC+P`@}N zLR6Xx-odNkaUOnk-{J`AnPlYQSU<@6JO__F^1{!=2kWT7v?oF4;Meb~IObGPf3Mq_ zQ*;!3=`H!IcoO6rhjw!GaW2*?4+X8fFE)x~IH<=I=dE4*%hWZ!fTaB!MUTpBg3bqQvp*Sre>(ZhN2k06XP5Teo^`1M#Oq z_36}}-8-$jlwke*`n7XchFOwSXC^5|L{vQ*w-S?%ckwV7Jdyqq@Boz zHWPTeP|z2MxPSbpg~uu2uigs|(!?z2Q{sU^^^U+b=fc)O+@H|qUvI}G=3`0AGZgdh zJTm2G1plcbdqqEt_B4Bkx&^@Rt(e~A_!Gk4vWnspg@ISMZ&FbxAg{(I{ec5GrX^bN zctjAq<>b_-!@wFmAwP-j z67of_PadtseP4AyX%M8uI@LZtQw97+B*=h21$Hj6&EE4P7wh4vdrl6Rr(m_~H5IVK z`lMI$=J5Z6`r97eK8R7xkhr#pUPZ?PezIX8b%C4l=D)wFPp`!PQ<4Q|DEwz}( z*G6YPPGg=W&0d{?4)w)l#O*2S=2IUjciF zPOkQ922Xc(*%#G?`#yRikyVO(ZIWR1wa3t#Mo(Nk2|JnV5n*#(?qtny440fN?O^;LtBc|K)F`|4RhlD$d{{(E;BLxJMJyej7aCMNjf`@I1O} zv%l~EMZ4L|ct*i5UVisZ$S8%sml?SCBhHDNSRIarpK1B!TK+{GX8PqKM+Lp2-jmau zmM}lp@BPShtM4E>j!C z-`BTN8^doYLo=7gS5Oyk@FR`x2>AW#KW=(%#1Hy5A9q6NXf|g%?C`uV!3^*A>bz+) z1a9PB#Cmv*w(a3r;K8xaXN=CHy*&qFoOJQIal`w#4fZ|tlxah}QQT=RvHAyms$tZh z*?NohiHz9PRou^w@e~C`3+h9DKQ4A%fc`Q_$?XbUddBT&c}EK4^ykU)FZex`{O%Pw z_?yBw>B$cmH-f(9MIjB?HGO=B8E`&q>SWav@cN}hTl)|2nX}WZ{}nER-|^*gGi~kZ zYG%5=RPe`No4P?5Z`}YUqYm`%6|u*pBL(tay##Z=@O-{D9rl-KPfSZKwH|PEgY}r_ z@i(YXbtlLcsl)iwMSo=jPCA+&;hDqp+Nx`~LNPwAQT0Vhu%CG{!ZRJTnC~NrZrres z$I28Xi89dru1n7_szMJWOnWV@3?1h&v3eNdnE!*@*Q}|rF6{a*ARo_vR?5uyt{r+{ zwAJtYkJ#78;#A~^aT;2rJEBsJd}PX5J;!d~f%#Vzd&Ga{j%VI)d0?;f9@o8ZK-cyA zHgG)_e!Gm~Q z5eL~a4WF9m03V)h`bWX9h$8k&Sz#U+yo83j__1!3S!xjmKPexp5E3MUZl1$o=Yjb9 zeEh2K3V3E-W;+!_F4pZ|g=%Eu!KZ90xHMspDG!yRLSdgT4L%9#0jGcawcAU~L;p!% zdsco3@$op9^W1Tak9IAqy#VwZ$?XMU7CfJ;jBN}4IYg3ue*k#Tq9oeL+3jl5|9CVPCsQk`g#U>&d@%#5%4UvUGr)x%u`0yYrhrvyG)P1`d*#x z-#bzVJTdN{gXtG#U~fmmI=)PiA`a+WHzS4J^p>OrcVZr%tNp#pScN(&zYL;c_#>Z5 zZFxE7qe=Ydm5bmzKcb0bTfnnZ=x+x&bRi$eL_D^a@4oYY@S?MS}z)Whnt#=ITdlubI*Wx zTsq>PRw4CZDC(_AUcoYVz!OFC_V;O{-YhNHR0m$NrJIs`M*-ifQ$JMDfxl^-t)w?c zea)`F$KDb8hW6A)RzLV_snO#nF@*jl(-ONB=+9#8GS@I~y}t^D^`3$+?KE0gfj=KM z<53y_u7nq7=iOQZuCzx66ZRW6Qo9zZf$=7NA(nFicoH!{|GRGnbwUegX>;Vaj0}Rm z0&6f{mV@0pIRBfh8E=&^=w{>r)AP=-hnF9YWSRh%j;>zO)das%65JG527b%S3>*>% zp0kCSykvr&#~)eZg!RGFG2;zRSf4xZQDk6SfcF;!n_1^$AC#}%yJSR(wsPOU536fn zU*6>D^1+MvY*Nw?Xq|5>XPC#&x%Y#uT*tYW(rm2A|3-+C*er41Jt1<$`Iry6=~tDQ zFPdXbAAiHoK6`G<-8u&Q6gel#X8?WXa8JoO#C0b1%CB$2kx$DSpL0cA*M9TZI6MP+ z4UdwEQ66yfn~p|YF8HA@2$Jzdizm{8Bw2{CfOcxs&f z>vF6T^}O`gA_N{9C|_xu*#>(PusPrbe_7tIQgQ3fGc6(?711B*u*7{%Px{4Mlz_jy&ODWfV|Y#NLJ@e@%B)k7gDrFv z%dQ1d;1kagB?))n>AvK_cqZ5{AEVD#sV+i(v_+f>-ksO#d6Xjn{&%WqOWhswNP3F# zXcBm@RY35cam+KFW6BQvSom+`al*b?T-X1+JZT5r*Kh9+eHZk*=uhp90#0?Ri$~Q0 zUru!Wlc+rpUZ=;M8+{RZ?z~nk5AacqA@=LA9QcVoRorWN;OL7csyniTeW9NF{=#!H z**34(0axekW-s{TJmTi$)dd*OuQL74{oq|qoo6oDTmA3(6_wuGPH98vi@P>PslLDw zn~a`wRXA=O;7R+0I^SwhX6!g{p6>Y<^B&-)v%5|yaCz0?lbIv<&0SM{2HtASTmBbH zYS>Gf3n%ZCKh}M%YpY8j&fS|kahnUgv?%aqmeC{ZD@Mm3dp;j^Oj`||7qGX-mZZ1W zLohB!f-c{Fj_Z!K>B)gd9aSuP**<~!AAH-$03JfgJz;vd0(qu38EI-3;@{oaiKM6C zHM;F3A}z4r?SM`0&#J1GhK=Sv0WKkUZ!Bz-Fl)m5=iS=M7MX2iFYj8Xr{QRvb3 z+Cgo-(6trI)&_xlf0!Lt-97;?IhJ}30zWk?&U=s(ffr9pL`(p0C6fBhkNrhl?#!k< zkI%-WNqn)Vu}X2c`Zd>(PxL^Z_RBe<;4v~ax~1YcA5YSYQ(f>&>PD}u+GXfO{2RN3{=xI^iVI@k zp)=y93xv2Z=xrzyJpo}xXMn2wq{qhMl;1S&|&M|fHCQBLCrfcW}rGAr~<_NvUdHJ_n9QxR&I^_K-z^|^R zBsaoew}%H#)4?CbiVsk)uOc3_1Y5Er&MNG6tmlKD$hp^Ibf%K=&4WY%{G}*ctKq{F311QN)2c!(I8be&C4& z%SChWsehMO?O3T%kNPHh_%iTg_-&UY2d+dVkD0%=a1ZnkCrFW^Lu; zgJ$p#hW!^4?t<6U-WyEzM1F83RV?#9>Q3o+cZG4E(P_;D^4b+WtGw`Lw;pM(0IFSG@)Q_Go&6Bys0 z<#%lOw_umaOkY^wPeaY6f${sn@4SU`KjOI+)$NZGQ$iOxCyamy9g>I2&>lRwF(&A` z6#l=mfv=Pf<6@g|S33vspiRYBk6^z}{H|BmVZWNv*)tU2PowFy>Ad*6O3Eugx^e$^ zzA`oR;(T{raX0q;GT_ksRA7F#L^zL9@!PWBDrnRj-^J=Iz~ zU%8$sCHNfs=Yns9eX9O#4ThLuoU3T({KjlfS z%Ph6PI=K#o=Lc_~9_xDcsKPDq2L0Z%T-K;3l37o5+kv-=4XthC_jJd%eE#?YKQfN$ zB;q_R6L$5};RM|(PoWw|FV=!C=NRZmtxPM{8R+BQd7`3G2EPBuukp?+_|a3H_U;Rr(p|yZ@!gJ`jdINs(*6I{}`U9L-)!3A+>SmcE2~UFY4%6YSV$^wnt^ z+XLWL-KR&rqhqn(sNGfOlVMno>-pZ@KN9cF?r}B}Nyh$hRTmz9!aj1lAvKYP*x$uk zhQpBX-UsWA^G;j1z6;f2Nh9pG?Hjj7W+m=t@5Kc#;MJ(~;QPIp&l0^@pHf!z4;B6? z`3pZS@2FVQM0|Z1yePm3e-6>-xHp=D_*s6@>uUk>E$3iTZp6)5HjT=Yh*ylMDU(_E z(6`K47I71JA^lM4Up4%>R4mYzpjR?F+V?$yeMF3MY;0ou#+B<22M;1&4%2-`jkt9> zoOGD59*Ct*o>g=eb>`vaHm}cEAK_%?xZa4Ps#We6*r8YSbw@$?Q{*1zm#KGvKbJ2n z%pjgJM^}>NBR=(H`wa^r9;Mu@`_KX&Q)U=Q(**pzH{D<)2tG+&y1?BId);il@}jv2 z{hk-9Z&Si9KI;(6&x4m=J7g@Ye;a(A{@%p`jF(4Z)wm9D@-NM?C8g8gcgnk5*KVWV zylLF3B8bper1OL$67`V)+lf&p0`6`8;sF0*Ru%C3tPGxKx+HgB2KT#^-QR?`=yb4v zY3T&|CfV;W`r$Z#kFzq11HA7MEqNOgaIIQYjRO9vU%Yjn&>!>E(0-})40x?1T`y>V{-0qT-L-=l3|AMZm3-w)$CCf?97T?PKG z9AeWAz~?I`zuV;jufx~Rb##O0yJvM#TvY(i?t3dl4?b2}IKZZz3I3I|&f)z6d4QaL zbu_NSK%sMm)(<#(f%$zW>~xkip-BzbZPe22b;o^{`T9>p&Z9rZZ;fmbylnFDaR+tq zxPSM5nMCS?r{(#7T-}F$+`Q+y-n2^fTJBz$D!?v}%8oa86M`rdF0tY%sH%y*GKR)zf{yp%?^4HQ=V&LG-jC)+yfUomc+*$A9@9S%p*H3-{ zkKs0^D+PbM?cZ8g5C6Qh-Y!#y>pI7@ENg>L1%y-IIS>C7`#1745PYjE%=KHtGOj=K zE+u0Hd9=clU4@T`C)+|PYB|U&`FP)3TOp4P9*g;-g1W?8!G#4Jjn^ZrjrFjO$C4)_ z&KlQiZOvkhK;F6b@Oc8_LF7x{>&JVM@4i@h{0O{&^u;{WeWH|{fmy>JQ5N%3Kxoh{siFTftc#l{%U!roS_UTr($ zK0g17nEM5LKX{7AKEV_DXz}@M-gwl7j1`?dvXCz}OSgyMIU0E?g?3_L|IfVqFNdQK zAw!e4APhK7v-gs51bEE9=6t_U=%o!Yt(CC9_k3dIfNE0}G7Pvh{%NJsd>#19P%?cstXH%X67(a$4-d}mI zp<_{3of;^`IKIi{F^WcB(fM610QVoO)_##v74?Lvx5LK45h`jUx&u1C1qMM6xT69i*W55f%5=&=4$O*hJKJ#BVaGL9i zmvT68`|hWtE84jJF9lWJF4)D5^5rjtbrVTDw6X5+8=o=r6DGi!$+F54ZN!y6&&yV) zXJ9vU#S9+sGhXi7f0z-c(uG!UG~(Ew&XOICzn6(gzjd<}`kudzPaFJcT=%IM8IbxC$+x~ zIHOO=n#1*n1M2oJJ#&hV(9f2nq)J>6H_7Cga z>Y2E2?#m|=OoE{I{SK^bvWH&09rfY}@Z(vQZq1|&@a$l41KmlSZ>rA6lNI&!wWMMi zTIe~eHa9f>*vj#)dh|Q?Vcp&%_kAgN-;{mzv@Tn^t(}2VcShdyW2Q(2 zexDv~oGSGS_*MR#`gl3|V}|#5Wh0*bs`6mGi#Re%u@csexFApbzNP|x4m4<uH6tesxbtgMeB>D=o@45? zjv;V7{GxbHJ>rv$*;Pq<Pf0+Lbes%5GA&3TYJxO0%oE`By{T;)0%uBbl z;1ww%9kUR#4l1%x!#egkfDdpMTa;6ANYNR#b>&z4QB;{-cs-Z-9}gg6rN!Acz72nTaJ6oI3ij8?%Z-&fQO8B5BS$EOBBpgkp8l?a9A#Z=!X+U@%*|kJp`DcE(-ubeo zIUUqlLio~T6j3L9#LpF~iTz$E$mR;byGmG&E96Ha{}K%{9{@h6dMeA`0&fd%vtHLG zK_BZ~ngui3w^l@d^q_KMpdEN_kal-}D)i$!X-6KxE}J5cyi4WYZ-T)2KL_8 zbTJ6m4X$aWANvQM*Tf~WyMuUs(92pHN2QVfC~5FL$=`)R7Q&Hq|LSG2s&7PlyLp%QIi5!LuH+G(})uQ}WWClYpzYhQhKr4q(2OZjxAlXWd!& zbCa+R!G!)NnHBtbPq0YDq9kx^ndhnfCG<1y;anTVIDe)(m(Ga!B1`x!{?Y(;mcVk# zTM6};{%^TkBFLY8iHFDF?>~&fxLfeNhlJ*ykRo5^^G)je4|rg#b756sKjP!uf2VaR z@cb;k?8iwFS39yj$?*A0L)Hm>jQh?-hSLI=j{vc7skwc~6P8pPWieiS>wTQMzz12e z(tDclzZX$r8zhK(X8J?nrSR`RldARZS>R)ZH`C4$cvceoh^rU!q??Qb1YIY)_;Vy- zeVk170KE)&Y8Wq_iW2Ho%k#UNidMF#jyYou=IaPo^ zs%jJog3u2=9yT?wV13BCd8aBF)+tt8%tqYZ=rW54xiVa z1|D|0{ijR^y)*qQoAO2EOIy$OY9U_Hw(BNzl_H)s*OXHJhkSpiF@hg)YQKexK4JfW zpL`n&H{fp%t$6+(5riHoCy%|@XlyOeVv=!htU6F{Na2-4R}+NvV9iGbLi;x zQ$wooGlfL%^_wN&e}N!xA%J&{6kR4-(eDVTdVRYu?EjI+z?cF0KBZ1j*-?2ym$Rj(toqC zCw*J82X(N+>)CqQF0czP-?*ea;5^G_*}s>t)9*~BN5pZziXQv5YkolY`e?;h3S2in zy~xUq=lolS93qwzVm|2@Cz{_h3%670ZYiXyd*4>(=o=gENaZAB<?t|jmnZL31hbDEk+0={*RZe<@l3Hz&Y5b3>%b=ZGSi&^8oTn%0=OD{t|6#i?& zyoU7)O?ES(q7IC!hK9l783TgnwxWr6%a*U`y#ROh63iR|9bQc@bz1*?z)O2 z?0av&4cT3sk3^5C1^*xa&W4yUuUF=I+ zKz@1sFek@5=;hNh6t=+StfE$(%VW^tVosU<><0ebmUvItM>N0Oc+UiQOwDuYgGX>b zA^*u*KLegGiCihY1U=y6ck(mR%gD#u?vEtm{PZtU+z*03Sp;6HAe?uj_PCi5c-0L$ z&vM^>&Ax;2+%pK0O@!;pILn z*qauy$u02sak(IAwLl2E#ARAcW+L36L_yB**zhp!|=b7 zg1ITgJM&tq$zB}Yjkze!(_+2gt3cmT*nN`K=Aa7f^3H>=5ft>`8y^G8fE#~dr$x9`X_`bj?xq}XIw^nnIiVe8v zz!CAIS{8hK(EEKac+8(4tq-|%@cr)_PHBkiXZKaOIckG{v8p<0!Y)lIS)B!e!_qn? z0c-G==Z-f$J0*}u44gHf!g*Y>zN$9UC<=vUH7< zK3~kA{(|F}%=owx;^>kNO`9#^K=$r4epc93E1hF)Ab1vauVzliTkz!R2x>3b^S#rZ z(%(l=f7&&^xCis_FJdL38Apz{k9}C+FZ&ntiO<1qGYdHV6)<0u$^S+h<`B2Jt$!E5 z{?lSZ-g~XW?&I02t^Ps>j&!)+jd^@EZyFg6Tq>Wnl(2xkVDQ|=@LYdp>>Z6@9}SFL z=cBlw1CHi@=Hv&CneTq);07;yYL{w?d@55YbeEACeDCp#@1rbO4>0U}EF5-t-r!r! zCI{*kBD2_`8~ly3L1_cubL834jo^Bfq;e<4FfTb#IWFq(Q`J=cqgp-C4L(S1EYw2Z zVXGLlL_Fk3to-o+ew2RThuJ~!)666@t6IcM{`+HI28eGIvlZ92O;J}nklkOX3%%u8 zRq~^2h_`3hAB*63r&`NTsw6_6ZKyS(#CcZ>c=X>x=MbnJ`$JR(e>A(Qu!HZno^aC< z1>*0n@7ZGTL|?%0-FK=kh?jk%O=kplBU`~QWT9JK{9^fs8~I&Udhx^k z7~ieP!!0D3=ZDwQ%ke$|Ilml(>zmj|ciNGa4DZ7v5@+8v7`K(X7d$ktGKD^F*BBH=@72aO!{(*72R&JM>W<`qWj^rnZ$d zTRCD*C5zvv6P^|mm$ApbzU2yctkd!SsdA3d6?XK!%fA0r`5JsJaZjvX+X;-x))YBG#i751#pI1H7Rac&aLe-|><}=1~C` zyoGi?!mj0}0~!Jv!KYXYl`P8955ggP;a)c8;ppgCLmK+{98T5!8b{!F@6^o9Y%za_4350N6^-*uKCveB#Z!vsxN8D8tobgP{Dr-KK9zd4 zeg^&XD*WF}lTpVG@BQ6*6ZHw&?lu)|?BDUoO0ovyK>VDf+85`OCZbzhv;(jAa~BT* zAK!U8dO#->d_Rhd?j`t@I75f>XW$UA+G;E}{N-j)$i^c_;0~V;nQ<<32Y!1aS>((5 zqhT#;b?EOPuVxem&aXw9Ql0h#-kEvc`vhK6+3BRX&WHMrR>-D5&J)<|a9jv^&YKjv z2kOAHcBf0yJjjce*~!`^|DfJpQ_e(+qmz*A5ijtJT#n7t{qXmhi@W+NME`q!#h+p& z)CByPIh0FWj&WT+m9}mog3mQieN7SHDpt1luX+Gqz8|Y#%0V6-x&Kgm9_E2A@ITE2 zJZ~7+!|-JAQReu7j_1IcBlG-f;G-wA)`l)&{92?nvJ!=WBRhf5=y9D#rOJLJc)kP@ zktbd_=6EtC*x|Ue60x@xd~){amrIq<(K3F88k>uvPHAvZX9_%ZLc*o0RuFMigr>yE z4SIf1K)*->q5h-S=l&7ne3vsmsTFk;vOrCvG^|(Ty%i+ria6_I?yTzoe5=vovWP_7 zm_Hdu*dM6~@pFvU%WsQCxR^DDb^`s`di~ zaNSK;NL>y((WpYX2m|JoCP{bw7W}4|fw3WQAL^H*E)L9y>nGjZ+?^2r<^QVkS?@v* z-oLeb9)It#^JGi~aiNso|MYF(@!gIovIZPuB5von!JcTCXr~SS;ks9pLp^bw;Luwe zMd0sFSsbq@z5}m|kG|X)h5k-Y8zKH4y1-5k{g(lJ-!#7Y4tCGn8(Xh64BQ^x9F`;S zCaIm`I&btDNz-)yQ%Ah3<~utA9KESI{f)1P|BOtv;iK`H9<)*K%Tf*%r1_{=nZlm?_Yj1D)fIn67|Y+g#DZnvNKMj-dtGcu_X>(vqPP781`YWe=eA?4-#?X znE9g&^a17j+a@3$v>uH+OjQM*^S9{z(sO+8Yh1}54_;5^CAilM>oi_5E(JLvKNl@e zDRDww=F~zE1^$1d`z_HS6#Z?$-%hT~nq1rvVc z6&(j2Iyj9%Px$elI?Eb(Tx1_98!_~(o9`Ia$l=ct2Xt>zgEu~}9pi!hj0z0uB^`ne zM^t;tANKRjvgchLJNSC#W9tCK9rudWQ78DL&0%>%HuzIsssPs`%!|CJFsU}|o~^WZ zd=q}foTi`5{s#HbmWXq5ChB5LPxcwWPkI;bKS>(4x(5r;i&lZN7K!=L8S0g=-IKu3f_vRRQb>E>6T{O@wy02vCfbV$g z5pk6*+sa9v+to0{du85U8nzQ1#r~I~2P%@V->oX!*}?a(Y~@^)ih7l?jxOlgQ|(#s zqTr>R#hWY`-|H&82e@$EdMSGyoVWXW%gKZ#yl<-KZV@N=l1Bo)MA(F_-1stUroty% zxp#L9+g^kB*k5OvtU=u^h+MzZ9LEnm$=bvncz@>mQaW3_FHlRfbR!7wi88IfabXno zyZv2yUO(~KSbyZ_Ip|Q#KJf)xKk$CdE%|#~{NRBP73f(pZekMHZu%bLc=;5|0PN}D z`P{@&@WxY;+MO!!U-z}v)LV!{7R06X{f5B*EpnOP_Yp6&gn6kRf&Z-Czq1(uec)lO z*z#@U)e95Wk;o%{5ml+#Aue50S2Cl99~_=CbDXA?Z?h{Yw!`rE(}Q`)>+LWlz;aS>bax7D@)hF`Fwp~hzp zmU!+V=4?4@AJie53YaHxe3C1m$d2>V3;(8$Z$H)_Vt?PLlLV7(X)swy&33eYtd?ibuJNg6UrC9}uOC)7M8{+s+VbqK>$D zGfKh~I1(X#i0U@-g|?w_LrQHKgdmpz5*w}%t(x1=Ok8z5Si)S-Ne7eC(bB_e$%cnpa(HjfhZdH&j^9lMK z&X&B4cnmyxW0>dy-X&Wsza!n-5(fJkIeh3-Pd@lki^}ZG9pvS)t(6N3 z@Vm_6RZm&;{XU4Rbwxbv_6R)5c@6P>E}djS892<$P1X*bD(L$g-jBfDc@;@RR^$Wk zp69K;1m1epzAR5c95z;oKGM4d{7oQPNCPkU?dh%80382P#$D`v0`Z@=#(oWPu{-u* z%0B%6&@@dP9sEpxLjB>972x8bSp$}B;BI?bu?xnrb*4_^-C_9S^1sn>oG&^$aF7)7 zSUz@bpC;mp1)ur25d8Lt;x)VBPT+3b>r2c3!T(oRJ`mP(7fCdz{Xl$>ZT#lGjbmDF zdfhU<=q2k#lkjGcfJ6+zJ}KY=3>E{4OY zz?Y&QWasE$M_<$#xo;zGrI5^Mci{f`6fLbC;fLQODkv9V2UoVG!dap7-D|5+3rmI$ zDWbeEU5?+y4rrdJfX>tt-e8)9db8V!1HWuAZy~i@xxhKuiLXqjF)mS`WFv*aKb(9E zt{ET0{umrr_IF_1lnnLWM8jTHvZVM0MSxFXhXmgXV_bIx3}W$jiM(nXu^7LoU|T(V7v;E$wB0TotE=-1LYuBQioOej#4 zdXM|N71QGA2A-|r`e-lXFX)s9w)6>lc)Ii5&_bNgv0Tfv1b)Pr<0tkUae$AKb$A}f z_|;SYxq^3&9Ex6I0-qWtcJuv&@j98>`;ZEJkNB{Gf;7HoWc9tPf#=T&P#Y`2b33*u z9!x_1Ns{+2i5z(=&%M~lbanLQxuls(OQD`5Pkoc~IQpMnr|@vlz-|_E^zA61SE;#2 zQn911bi;Su_X6x~UGt2d4f-%t&(!@3M&H}pb58eh-i?%b3I*^1x54t1{aWawapq<$ z6TIa&%Zp3U`V6Tq`{ z+&)!w;PZd19BDOas7FTg%)Cc@vpkVX1dRyqk!n%Xs>OIdE2`??J;8bSqw=I#V>NKFDRHvxq)%dy_~S!4*NMnE0$n2 z3?6yt>XDb9;YTqA?+oGR70X{YKOnCf4A~RiUxzqPiwRxSikoz@Z2H%9dT63VG``WnGyfoM-9JEReU8b@E*MFOx%Hqa$7mCtY}fW zOj|k6ZqC0ekMO?Dy20ECyfJaDABOS{%ih2xs_zz);^0}=s9B5iG~kDKnp6GE zpaV4R(X+V%J=giAJz<}nkSyN88t{aq_9N34n0MavnWRYk{nL-$5*FaypG@W4Xb~rE zMHnf!!5`FvM3%^20B4=5Y{-G1%~HbxpCW(*AD{5-058IRzy5q2xVfKJ!6O*+#~nMX znO}^2wD~{#*hSbkMGILB>}`;UIeYdW>I604SIzVBeAmkUoq&B@HF^0Um=X4@eYJ0b z5A{A{w}DyM(UI78yEx<>Zl~1EqTv^n*;=vWzR)|#AMs2*L|&xh_$3znJm_)bLpR`o zROi(71n@`N=BAhPorsUAc8jLi2lG%u5y$Io=&j$P)xR}BuaH>HB=F7-_lsV4V}KuB zGJJK9p(_|1<0uS7eJ1-`?!Z;V?UqhTcLC&sR4biV=uv;au(vu37^|W|6+Y5_CKw$h4uo zzhC++*v%e&GK&+^%ZPUw0dLeCkq&TB+?=2IXJ-G zEy+j45oe2Pw$)`(7kNu{(@F((lL4h0f{y6J=grwy`v7&BImtbu-q3UASjw+~_h`-( z6hz9S|K@~Oav%5+gUR8PCy3`*B5iXL|Np)WFGPj@psYJe=s(#TK>5T3yhwM2g7)fP zVfogAV zGVasaI7%#O0J!s6{y&da?8Efrh>rSm;Qwo}*|=cna3@J<%goXLF}Jtzi4pjB@%ZFk zcf?s5j>r(;zMjmp)F;q6YBXtUX^@wceyI=Y!hO6vY56l9_#j!P?WEt%SG_y+SKD`(FTJdfmP z33MWw6JqqP7#}SoHewaTw_mXb8o7aoPHH!4DKQTvSuGRD*Ox`Lvl3q9YzM*3(D>fw^#^M=ZxLlm$*Bdq(n z(b!6<44xXZ)N)uA@gQgE$WtbatE4uMOFwv)$PJGZfyh6|+9(Sh;5YW^Pa_Ea^lnLY zQ3`h1!EP)O2YZ~_cbLl&Vyjw(ssTY2nljoPAv=2OCBVKLf0Q7eSHe(|A z*()QNDJR%bX*QAS1Mu@_`{TwsVZWk(&mXNpTnH$VqHVp5`waD9_;nV1TG`hvkr#Y& z=u*W?di3GZP#RdF?}eX|IV=fvl%S(xx`BwFE_MZrj}HRxiJzLVfuH}qGaX-R0sST2 z>@vS2`bNfHzgILxTnfKDS0Rr6;F@#^sr|60WtYAFd*MeW%(hG5Z_+Y*1$osmK1-MV zU0lFx_Lq<_Bw(CuF7;l+_~{$p-tdLabDDlz=~Ei+Z(?~=6Y-{-t)h?tzi+xK*f0dU zRh4^r$2At~F5J|^lrX>E#8028^g%~hc2qZp9mw3R)wv6Pdhnw$)iv;U#*X)FPcV)} zI`%i8!+vb8pBuk}@hN5Q2)sRo^|4gOxm>_W^_mu`dVKD$kN8Sh=UdctH6|WB`pnRc zBdYK(SH8o?MG;523k~IV!;#P5y4iIT&o8C-;j6nL>KOMY4fSAOZ!LPxsr zNXkMI^)#}D$C^J-M>}L-rZrz+E7vEs)A}*jR<0oLQ}1Wg%M4A|57T#oFMVO9R)*bE zQ^|y-qfQr7DLcl3J|!Zz(jF1af5~~WlH5PGa+NWucKP66|BMyyQIdi8+!g-w6Q3h_ zYq|!Zo1Naf`6m+k)rkQ|-{*vNe#fbu^`2who=~3~MJntl|J}6!^hKTbncS661`mu^ zYNvv(_CSrJ$Y97;j-!9Diw8WeUdK?Ga}DpC(!Z)O4!dI$zxiK{7I^Mf@BW+zShrJ? zwfPr#-14|$+7$U}#hpjjm5`qu+r9QQ9Pz??!AO|!zC6eFeL|Q1U|z_sPD;E(z8u{i z^$h&rAhD#B1LmJ!TvBof{*q#({`L;=j>vLrOAY=il_{#e1%A&Y*8emm68VG1pDTTC z$WzjC`^)aYE_5F|tlPsLLp~iyjRxPg{4vl092Q^vDA5Xg+j~QK`jZ6wn>lO$IL`Y% zq3GI$Y}6M-S;@c4p)ULOF3S@(_=&U*+af-57SPiR`JfMq^V8L@8L;=Vt-W%<<(Kyv z!<3VeKm4cnpd0^Bk$?ORbv^bQG&m4`lL-ARi?q{=Hdsejb*Ne7Bl@3CgtVNp|gimMtTh4e#pA^`GS9my=X`*><52xZJ7@1Lwx!nV|l(1y1=f}HvvohfA?c| zO5o9z1@q=q;Om_Xx8&7P}cnju-0wgq>_}7YiWHiIeZ`(1<`??!(h}txe!15rw%5W8et|^A4qW zAI?h2)}ulJ2RW9J;|?!5@g73yzG4pOLSgGmZ2@txUk5(^quS6F7_DF3kcQ5>I^#-p z0rd)M(%fLgL-nR~X@6?;PYImAT?U-Xk@~Ru8}TA=T`l&$D0uR8VBKEC&jy=&N~DH} z&#MD1#1@Fl_wKBzoP}=HrTD;o19cQp?l!hzHF2i}v3A%p#L_a}Ha9j?~6uIr(;d4BMErD~II+=oNx>GTcQ3nfqcmp=HLu^f%N z9C(!U;c$J$f6!@JO%zvvqgPaI-kt4&{~oeSRRnHpJXAgMp$Pk=Xf@0gHzRKex>7&z z6?Kg_FI5@9k1XDJ`0pU@l~(OK5$X`Cjc0fokuP;s)C3Gew@|+*)?!GEc&UGhyl@%( zXtL;<>LTLXpX&AMO~gH-GQ|UXpd)(dp4ft)AG-C!+L;0MQ2Y1VBe>5}DY=6@{g}_F zA#t9U&^;DP{jAFo2OXkf&o`h>LB8`#wHy41-Hkk}1Lr^RxQz|-J!bomfA=x)!Qn~l z59B}lLTKo%zzZ(5MZ{|ap|4b7ZS5)IS-E?%TrbA;#h;Pj_ZT1jBGXYlX-{jb-=5iov2qcML+Y| zxu_o+(DSBE)P`YKn-4?;Niaqi3Ui81%<~D|rAPx^Oeeoay4(4Tb?qS9}W$ow=siE)p@x`L(Oz^Ro{2qGP zb^ChF3+{7x&J(TFhk=iDEyJ&KJuvTkNRN}*p*|`?W#OO;oKtxh_#5$}OOY!Kz$&2>Tt_1W}JjgLh5bwGW#7g}iFuPK7Y+=EXX{ zgRTSa^S_O>k+TGTAo1zJSWQUu}sYIYl#|Q14B%&q!O!f@BJL?4d-9+Van?wi z`|Ne_Dfe)jXG*K!F}-(EHsRl23dpb3;waSQW-&hteM*MU&8rpTnP1#20DLV{5jFJ$ zZxZ|b`e^PQ=xOKgN_%U-Z;#K~{Jwzq0{1Q`TY?wJ_m9UC)?;;q%1-A7L&xA{{5c4H zqQZIQkCrQR*W}wx^59`MC)Hnff~PShlm5-TjCyWlpTh}p#QPUy3bCBvQ*Bq{4`SYO znigIN!M->~Lu(i*!0)*Zt+b-v*O-$eHa7xYDZ^?H19(nrU5JP+_!T8{wZdWWsltvo zT~m43XEUQyy&K2wLb6xQFKp#%Ra0kY!Ee6*rVZ=^UmJV#N7jZ8eC8MFF2RoFXdHfO zUh1U^1p+BNbR*G*S`=5-i$^CqU=aK6=6u6gL#O&$1G z>G!s&OW;{6h1X7XqCPnNB=d9;j=Tm3DIP=La+Lb!5Qu(tD*@V$L-?FGKgPa_-&>9R zJWB`rn-_b<&H%rndiT#*2KL3Mt)M&Xf;>g|a`$v4##=0Y%zGXALkM+?4{(da{ydoy z@K~g&N`(&d`7u(puNgS0@KMW3z7x8t$<2tMAJAjv20Q1vn?Wnxg_TR_;lRxV^>SFMoIX2ak!rF`ua+8zw58iHr z_q7kQ)W1N#d0n2pjuGlqQkSY|XraHT&hDsv0e9m6!QNDa^;{@WR9^1=_ zIOtM}>6BgIF(0z7@A1a`a;zq3=OV6lx|%1@AfDbboXq)!IO6$twcZ?f?<81t^9SPg zqffp~?+#+UwSx9xwKLFl1`KcLBVNpFv?bJmCkKkGNgl!cu~~fbS#U$0;XvV~XxO|EH;4N2g)Du6z?;|utTTbwxK4~rV<{|VT>+!{ykBF0L=g73qE+Brh zkd%88tlvV+Izq(IV!Y~%^KUmA- zTf%X-#-WO^&g8cBTm}Wk>-4#ZnF4|zuJ3REiM)g>?K$5P#+^a9=ed&<*7NOr(cOb_ zOl)8)`;K@|`or|tBJ{-<9_Q#kga4cowiRwLkN z7p80o`z0v%wY|3ho|WbH+-<&$zPm}k?LFWLM>Q;-aXLdUq<-s?VGJEArsVe?CDgej z*S@gg`pJ^M7ekR}UT1PTMtJ|CiLd@^72qSC;kODGQEO4Jkd9s!r^_+f-p#W0wVDFXK&F|2k&bjUR+K2pj_!8e7)(!Rgnbmo< zrW@*d7t7NEp)6XIUJ;nd- zN1olM=gxi(czav8n+0XZzsMLm%)|{x?x3w%|?wzVDUB_!Pggrc5(K|H!;i`9I9VGrGNI!Qe@( zlK+O8VMjzQIR?d3(4qGj%vr$>9;`C4t`Pj9Tx|b{F#3TsC11x8BMxk2Z0|sSNUT%y z-No}YgxtNo*kLQD&wYuTxXM;8x2(0wu-aBGJS@-L3;M=T{MF^t)aVbAt90l%hd!d| zk#EYWBSxYV<>?<^X(`^&Kr=SqDqyay$`6?+Kj^mcGx6(Pp7Yz?hjbpZm zcSOZH<1yg>8Mo7hGO^$4?e9z5`QR~$)W(0|uT-T6r)M$$Dv=hSYGw%Q5uEyFR^ex7 zwSvjPpWKWiYq!87XN~3;RsZ1p2~8{1;M+bDpQq))=R3K)HVA!;dGh(Y8W_hP?%t6y z;77sl_nHyj-<@9fmikvXbmE7yQx@Pi3cOFgv8yBhsci{9k9cag`upv&6YfJl)UEd+ z>LcIgje?*nh!H!l45vU}U`>2b6bQfkGWPMLC3y4ds^Ww)bdr7+ju?LM+4iU7ACF-k zX9GSca>GxFRKhq}!H>k>=<1^X+u_%5A$PowWrx#wRq!43B#s0IUG#5XWvf+o|#K$FbLCHuej2uUZMp&TQ2E4h@?S zuaR{vmSG>Nj%spQ zbKEzB*t8)r>V_T@GihQ+z#|8!X6p?x{?gBz=rCUU>I5u*!CzuX$_>&npAX9$oUf09 zAMSNkul^6XH*GQB+zuUQ|8m633E;B0?^a*MzrP4P%9D6w8G!vKE>0VfeTIGVC;#Q*L!LYKN$&^nZQ|?R zI5OCY!9x5KI-E}-DCtC#9{B3eRe?4WLOp$rA|)4mw)xn-eUs<|(b8bqS^>Z4_bMUm zQ!+hXFJJcx{Q0k;$qM2{&6g&?Kajb+>4J9s`Wo?Fkguntu?wc~Xb>X$X%-Os)P z_c@22Z?ihc-FPssprMHO?;f8O$xwEXt3KG`)`a)%61zWI=IKDcIBDK&)ph9lu2WUN z5pP)KKkpLgoE5RN!)=&vAB|4ef+v}6*3;ympX8toM-2RO)=u{+Ni=ZKS;ysH zDDsoFq#eybtkbBSi}i`b`6yj2iLl;E*yl{l8SoI&*Ojj_nbDW^xK)s_E>;nTQI zn(kYdy|+<+{ly~K34X(&Qc(0!9{Id|=$_0I=(}ItmD~a!e!kb`ko$Ch(oDuPnuO~kpFc&F>>lap2*PKQ;oQ_QZRk4Qxka)Uu2GjH~NJyhnjeWpx-KM zS4|5#Oev*Y>tQqKRI_`l4Z%BJj__%!fOj1(52Hvw4?g;!z@!p<%IEAf-Cm5J!XMig z61Yy`?vK9}p1_fw)q#swz>m!}a!iH56N#%u+K)kBxOH3U9S7{#%xl7&4fZX}`|B+7 z>CZ+PU55L>%ei*{3LZeeRhW*(89v0%cG@fSz+WqWBf0Ujh{v~vnQZWP!=%fO?~(5x zmpwtQ*^Id1tLI4n47|i~a&h^ItsHB@^gKJ_MNrX%@+2MNK<8!2Zs4`|KD8hNjF;1+&Ay4crpRIvm-r!&@T`E;k!;9gt-1(_@L+o#LL@@V;8eg zFZt5-q{?Iv>#RD@K_SCBDp~4eV)W6dQe4hB0RD8zz)Fk;I@}o+vyfo$%EDtD`%)Lt zH>%3=`rs6zRv5s z&g;6bhv)q{_@$;saw-w{|GQ_}zFq{spiLE@-O>H1#B!JzRZ;J*{a09&3i;(N5tbb2 zTWj&#@~=_vEMP<9R1SVuQ>#o&$%gaR+ewacqaIhi$H7Gke7`{Up(3t#r|0p+v^AdV z3Z48DE6no*+N9W^F8*ZPN`^D|Qs(4n&rRrHt;)YOv93$YU()_~j(QX2+{;^Uu?~7d z+vB>yE6Ja;s!oC5Z&wd6|G|9l<-2iX{g_8IFdBhhmFw`$?Yuv#O4^jup$&fhhF{i3 z5%9;jo_1$nJGnng!0Rhm-`;&eQt;1*<>&jGuYbt@cyf2?2kcw|_Qa{nkp^Y<&TbI^)z?HIH?_w!L_u;tzBq8#j9+ z@EQ~SjgfxTxnG+L;W)QIzukeqtB^)obA$JVf9vQV!gClIWZSS(V%_jo3uGSyzu*Y! z*^hDjN^vmFC=l0q=gLN#4Bf-w^TY3$$8F!PtM9O$H(W*!XH|ih>}HSZ1Fk+;eb+HP ziSt-AkF3>02a}_jYz+f14JWzcu8uxhDMj0VVdppK?fqN#Kv%B~cKNA<`8e_2ZxT3e z&^kD-1e{thv@U7c0FRW6<#_=79IEUWBvGPiW%bJVZ}ZxtS`OucBdbJ56v!i zJvIj~k4$0Qe6j$$BY!_D-iYg+m%26vzJ2}8-8Z&a2h&}qmO8+rqj7c7t5|o(=Q}NBr)XZtg)s3{ zIbi!W>LQ+*ANZ_+I$x?s46X1ZiwQ|(YQT9mk6NRZT<|f~A%`sZt(c39*8@!vH?nnW z%0KYr-J$lbe;GU@%9=Co+i{%YP!H}mKI(AR7Vvy?CY37-JVQzN=@DA+#M6v-_EtcLI^P#GN(Mb< zNVGkbTm?sR`vFS}=oD{A$`+h4&gvwN`q2BrJ>UE`KZE@)?!jEu$bX#?7$JA3$M}l> z;ov4kort!_tQqF#j`i-VE)y8HneWRCb--EmV+*Pe!50|qRd(J3oG`&6#4v#IV@VkB zf-Xq2|LRsL_>AurqD4M`=s-z_zPt-Uz0~cGTtt_lKmJP%oe_gx*yu(TiSz#zvL_yZ zAJMv66de5qy7_WDm3lG8Nzp1~5_n^^8k5sdi+z%O)H)gPXS_Or%j>Gpzf0|IehY+- z$3WCwkO&@U{p~1I6zcfSX3Z4hx>MWrkDA=T$GxB3=68V(<}x;}aS8ohO|wN`gI_5& zcPVsY+#>E3e=>a!K56@&hTR+d@tIzsx-$Hg)rYE|@FU*KR26bU@WWB&w}-$F^vTrM zNuk?(ZfMr)!%;)ZHA+$pxFznZTM#;!W{Yg>frI$H z<=51tTNrPl??TiV=Z>7F&T;5ck1De2Lxo)kPm~Xb-O+R*jNLcxY9nzWWH$DOy?Bm( z6Dw>T#aYOsuDs-a^9ua|TIpWUJ;FZ9>Ejt^F#pjB{a33ozjb9>rw?F0KfLa|sTv7= z!+JPD-Uj}w^cN^)T3q3oyqAw3Vo)xTOjBzH~8*bT&=hNe( zC|co%KOqaCnpOjD6gOPaJ`cU%Qp&t2=An`^$&Yji_0e%kssF$aUOgT0zXZMSaN)RI z6(w}8k6y+rd%@3cbR8T6&&raKy&1<0y}ZDFuQU8)CnYcIX;=JTe3;#e!@ z^IuP?j~w{(eoB*z|4yJTOX&G=*>muhA+a*WmdLlzruSb0pD8e=FQ^B<-B`VRWT%h$ z+r;+`Mm5Om55G9X+X0=}K>X59U)+O7YDcz*p({3q-Qwy&9xKQt_Y3TK@_7G7Ed)cHN(-CI~rj(Pt&F*HPl``_>4kOlsua$HKg8M+qz2S0~i zPVj{2@SDY0&z_k_TBT3nKC|Q-Y{9c0Z@d_G!8j_6ynjE8-|Zg=yZ3uH{PhQ`#x7pq z>z7T^z@x}ph~*?O;@B3ztHz3X_@ObDn}BsNPIq^NnHaicH?L(XuKV(o*_C$W1?#qc zERExSWBAkBd!T2nE4R$0qrRPF&Gqp!*h9zjrTh+3D~B%o3szCO{9_EG7jHM za}s>qFoc{Qc9o+dTfg5N{$*Tp_XO!!RFy&CZ93=3)l7lw0s1z9R}ddoJ~_0KgK^nMA@u$y^jG2%Im&;?W5_Mt z|Ja2%o9`!e^aG5C`&%ooIN(f29_`LP3Q18xpBve@zm(UleI=;75Y<=x0Gte>ZY@)V zPH*yVJ0Lb1^-c$N-R7f#{-E>h-yZO)q=O0%8!TK1MR7e-d!bVW-T!^IJ{NfZTzNbe z@$|{$-z7h$Fm69%TBKhhu9;-AmZQGOMlHif($Qb~8_}~2ff4~2K zI|4lnk4am=FIsO?9aOyvTv+)q>+FcS9XkoT=U8u9nk<~p@IAR}jG6vT)a7+v`K{Uj zp7VifJ{ap}^~c>$9@n6&Je{s4y8~Urx0%5QP;oCr+k#obVvQOY8Z2`~fzCvfJ z8M}P-Gxk{wvMLzY17{8%8r}6A{Qb)5xtFoPt7TtZZQSpj-Fv(Wz~lMM8~lx6HyzRC z3b7Y<>RNO(e_%bf=R_=$o`D~B72v(A0Kc#?8uI{gRmh3-!4$01e=owwdx1yFjiu+Z z@O{$Fi@MRkKc06?+po;PD~5{FJ_g|bX$CK!eS|n^>T1;K3gE;Gy43u4*w=A5Sy;Xk z{3?mS zf3~Q*AL`t`e|y~EgM6R_M+y=0LhsV5z201ey@ek3ku*kr=qKgxX4Kp4qO)xV2Ic^qGmP>KQbY|l;FaGeKRQn z-c0b@UrGlkKY{OdkG8ctqb_QtO)~lzc$JnacQ)boPTt~QhBclqEc~;yQ!d8m$T?3Q z;0%vQ_G31j|4F&I>pJ|`uh7KtnFaLIdGW3AI`F}gH^rmG9`#T!mlF!Ypj-PA&OHOK z`aCIJcP|{gTUPQT#nGg>LLHa9T|DXqyyt$v0|4hU(zQ3Jqyw zcF;izLNyX%@I0lX)jNIT*&CzIHe#GErE490{{?=KMDyq*@Jv-R(#~KGdcRC1Z{Z|# zk=q&p$6CRwNQ{lS;^7A=THAKst2pB4{cM2~>oI28oSy@DOCVltPzK-p-5;O^fVv)j=qjc1o0sbY0GF~F>)b@CVI{kin$QvP2Mr???wHZ@3z^IOz8Yn z_j`^$K)tKo_mE=fT64Ffo-3V2JtJ3C+W^Ml^}=m^|2(Yc3$e30*I}2fW08@t)3a%H z-&L@F_g7u_qNRjhLXnlW5BVhdptsY~&=rPl?{EBoj#XdZVps+Jd1a0_(%SH9U@Bj*N0ag7%H*iyjQ|!-@sp*M?NDGfWJ@ZD%OxY zi1?Z&@`SY#?Cgq4<*GRHU{d;9@=UPTD>l@d6u^(C2NmpCz-!&fPIMlE4$PH&Neh1Q zF`3o(SbP>qxpTps9(k(hIL$ox$F?nVEfyS)(ZtQO{&NIR8tyS50*?wh>8yq4nhI?F zc6T?P`$fa-8m`AAXdS}~f8Cv{HK7Z8ou*)Rs?mV%cuaBdxDl>jaH++~3Hr$E!VvN> z_@khJg5`Vgn?wH7PYW@xk>v^n@QZ&VcZ;uMeQ%s}FWZZCvODn>Gacf$Lzmx7$(ews zyR>+1;WP6rvusKd#-&S*+7EFC9f=I5^f&xoDNZ?K7W_f*Rz~y~>_uexyEX9OBgL)~ zhFa(y=ih%&et~$$kYi-_KI*R`O_Qm;FfPw$>r=39q`h|aykY~M?6P>o2_9qoGG+TA z#`|h!(JM7U)G-(i>IlJ)ZqDvAwZr<(i9Mz=ApyISq_8`ovQr-rC%gfkTdpbTvL8ox zPHrJPE$H?}d4$*DI2 z&s;u4^1T^)Tz=*?{sDHZLwgC`K|I&nn}Q^_V!=~*!b$XlF^*9u+=p7B1IGV~Y*Eo=@Xufq z&SU=I=`Kw(8MhJFxHg?H#Qffhm!0SPf%WxDf_wD@_Jz4W@bE;El#`0v&Jw-Kl;pDm*Uj@*fP*{%kE@cnB0 z7~LJz(=n(i+o)gKBkOGiK5<}8;Fk^7iKJ|(=^;JT*?L}Z9Wz7y@^OiO8{ies@{0Q3 zL!a2Z(Kx?^JY+jXQghk}c)9&)wXQzkn#6>+K^ydzDbZaE_1N!|Pbo0)c1KsI@hrxA zt64qp^(gLVL|uiS%L;Lhbdjhh?lUKz)6oHTXX6#PdIt7OY`V%Wz>Iud;Q78kRPcj$ z4LvWA!md-)Ul8MSXxshAO7M?<(W2`7uyf<#7f)F5+#S?rPusvdC6>3Z79}DcHRTf( zD~3Pu)YY_k4W2oWV)PUKxh!gU#dH|<-(*um40}8gx~Q_#pD6t6YWL22eXlpYCbt5g za!#hy+k`H}8}qD5Zb!G_;m`dHKJ{ko-Oz+9`ixPsg!e$VT5BAv*yjzN6*j>@8H&D5 zx2j{7aUA7SYwm!ar7g(G$%gY~-8)$2wt@P_)deMrI_z)p^*%2T+@_i=QoENAT&_0x zMD_`O-hS)CIyLr_F$voA@S~qpUiyhR4)lXLF!D9DSIr{xR-PB0%#u^H3;rqys#`oLTJ;DBh`!!j5X{hIVIec>K3ijiKJd5w$ zgSu-c7OVA-IKSw+5eKfHem*>Xr+#WR^Hbp*j>2srh3`EP-$w8@6$JtJzg6pU6@YI% z*I1dyb5I&w4470zeO5#VXT??Q&lIuB(Xt0$tj(OM0UsT45Z!1!4c=PEO4$S6Hplge z(e)5?v(qE;(WqxW!LKfw`4j8^^gfUASMX0q^`5dtAfLF^XV&M9@sz&G&j=iSqT`;F zH-!CMQOO~OGCOs#{O1R=vHrDRohqSpAzZ69qS8m6ylAxCuVF9h6MyJudo`oa|D|~S zTJTAJ$HTTs7RVd6dYq6xf#=yI4&r4>)7+*`Kzoco`T1=secqu2d>x44J8d2!2ce3xa%~IJPrPB zEr(D~p8UNtn-V;iSwzntem2W~w$uZ4@d?M0#N^-yNgUB1oj zA>@^#E^VZo#(KVG-TYV&eue8&$wl~mPHf*iqz@eE%XzY823#7S|L5(9JecIZ<2Ny0 z+QkI9o2jsSvv@w5boiY`UvrCS_@fH~yUJn5)?&Vg-8G@tY<)grp^UuIJ@u^5IM2gZ zZ%mJ4p0#M>$0bYge?iJq7M;*DLl>HM-p}*$VwgKO=DU?)<=;dH{H~juwIJ}%Lgd7y zXTSm7<}V5D8PHoS`U_HAz#BE2a-s;p$(Ev{Rv53pM4V(I2a#7Qxc^%fxN_6$PWCwb z^C-jLl)X6q<=z%jx5m0AZfQsc?&`iS)YYH}o)pUdBB*l|=#-v~NEk2>-`pBQn>JE=)y`!??P!KHs1)VR;( z{_#j1*mIbJOYto{pWh#ONm?b~$~{`vDa?D|g%;B@xUR;kORqc?o-4v$A`SPYSQz<4 zEdY3b*2!V+I{5dbaD6tOrzGWexHRT3FI8Uct{c`zYi@f`^-g`lAcN&+;55tI3Vzt{ z`-PZu^O%pJ;Q(F*oNqAIVxq$s{AokS$t4!+$-O&g&pXVg%Xjxe;ApY(EjkSq=tlt^ zvhRRbOg?Q~b8E;GsH@}d8YpZuqPA8?Um zd7=h(`*FS(22Idy2oa+JepG&&>$p@59p*RD;1{gJ&v(*d`~8te*_vzGggt+dqy2T{ z5#pp;#WU@7=x?SfaP`hhtfQ*?-*tdz)G9jDo>v(^WDF+*)To6D2ke zp2j2ZlFNYpr6dOVCddn3&o(`F><8@NrIc7Ha7%^ik;g9B%iGb=z)Jkz`H?-uJNhW) zYc`jpLd1a%tdsN!zxVHwm{**WCw)Nx8?gzr`ZezWv{ z%mmjbn2Ffa_o1G^iE`HP8+7bT7rgBb!>$k9W*n5HfV~DQ-+nBNe52Wx>On2wnuham zm;>Uj!)@eefWIDxezO;Ye|{h~x6sOhy+%LTlZ*SQXQ|O z0f`i}ZE?77vXEPIdB`UjL_d4~5BSaQc2&gAnQ*W|#4Hza;I?u3bcrYGzrS7V?}tw6 zVHD6Fi#mCS+ke=Cz-w0AE~O3Z1@E~bp}o^TayNSb2O3)u{??Q5u3H}n^2S_BYJ=bjfULp_bQ%i_u$@^GJ|CpE)R zmmhRK{`@8E%Tmi{EKWjQl?|mU|JN6&*O^nFKUIYHustvTTwLNvSfPrI`H+peXLng6 z`Cvyvxer@Nr>`U7Lz#JS7wYxt9zXn%1v}vhc`$Mmyr|5pSl*EmxX^L1LLAo@+hmjI zAYj~#TF)z-MZR68)oVZaL;u|1%~HfEuX2j+F3>=)S}v0E#eIIwa6LG*iu&u)A8%NZ zKhzoWJ+}+z%}rz1KTikUgegxcMhtm4s_f&P>hS+RRX(jvIA#w$ zD3Z=NES&Uu-KX z(FJ_G==G<~b-*Owl zGpHz-E@T;ipOcc`vbhQ!#W~(WA{ab`;^T4sDCixHhK)HfSXVJ)UV*?h*4J)>aUsa} zO_Imm#`BI_pL@x05jt0x@gzOYdtRP{wiUnEE+6&|#dAN%yvVT;2%NQRZqflCf9bR^ zX@qerS5TK=2cKw;5mmLg4E}esea&WT(B?SH)Pe& zouXA4uCw=`-)Nh+R6g>$&JA?&m6#{NsBTF;@b2PXgPy-@j)ca4JsA@C{aqqGE}>80 z$pXahWRNE`Q#+)wMh%`r;V73ZiF}=2EOVD8K0o;MNN27N$T=5nm;DeNm5E3s~bj?csW_MZ^qpjVzWWY=oJvzENxu*06KSTc_7#Xh@Q zuhzk*4d~yWX0FZ$dv-g!pWo;x@L1M1Q(zQ%=AXVByK$X+#iVO=c>Ys!l}$=)h>rw3 z{PX0nK8`ij{|3(fr}KyZ-v9qR0tUuf9&dmfFDhgWjp3(X(7Ze}L54bzi5qJVpu3C{ zomgH#eb3grs`l7b*x|adW<31s5Zl&uns(?JApw-sz#&e@tOGlFIb1YVn=+Ss6i-_hu&=EaW%*b{=s34Q4svBvhdoQ9b8hMmz^&vK>Y~edqz5V ze<#cCG{sxUGyT*!ON*m)+3Jf(oc|upr;2SKtV@NI+dF=TM)&Ta^$Vzv7*V;=sDb@) zhKElR!EUb|S6kWw4mh6|x{{6lC}Tk%_-*L(5GaQvSI>u$kS;Cq;XkXRy)PMm%M&X}j} zzmNAG!TGiNdlkQ~;JnG}(wyLTRoUU!`i;;JAi(j=eOL5VQPqyUGUJlX?y$e9znBliWEdJkC{kLfOG4!j@Qu^Qy-t8tN zzR-bj8!nMA}ZDkweWgj1QENmlfGmJPy9~A$>Q826&EZrfq@r zKk)v9pW_w%IL~0xn~Eyvm)}261{A{&7jQ|c)FFTFYZH8A4*s=Y@@vo)&00dnz$d-(CH-%;qmRb5xcG%d^fS4%wx}_J`nD(YZSoiwad$RS0q|0n z?4udcxUNdsZ81a4leHaZMjhs%)qj8X74Z4NGPidj*I`F?e6zRRu)ogEd1eOdJxVxn z_aj;4Gs-tvo`9FM3;Nv+hadE4ihCvkensiMAmxKPD^8J>?c4pR=h@zS>>ui?oImWH z^+cYqG_b2T0`*oo!}06NS=cXl)8z%1C-fv=!TSt)*ymoe={08NNH}Eli2h}`BO!H7 zZ7(1AR^uwutXCEKKWlf*X|J_twZ2z+x>0HIvj`#a*0Y$iJ^avEOqUx zqv&6s^~gW_2=Ik*fuvLcdcdPMM~acxN#@a-ehvGRU*ef>$2gfLvP;$6MLy>2&BK?m zUQfiYWeH%NB)^cq{2Dx^P1~m=8~jPS`mL0k1lG&cjXw(epp*XAU<~4e4$uESY^Se~ z#DM8gCGcs8JEGqlxO7*VEBVkc@MP)GX6Gz$tUJ9kYzE6Ed-49Sl$SU#k z4(#+>JY~n9a_C3Bc7CxqX5Q6c&C7<)#6|LR5$jy&v&)&w;8j@?mV2T+upVn;jRnB3 zbhC(7mGIo3$6iyC$AOpqr53HfhWb*m*s5{h)@b-?FB)^`U|i}Q2du$QQPqGg>=`WMbYW*kR`IG#|ui;o#KI)i)Jacm3nW;(4e*vf2som7j zxu^;oLuqk+&-WL0`jd*#Ze_j1x)~-7m_}9=IOu zcap;!I-_XqvzxeIX`bJSMIw0qzISDcyznE3WyXfU+fIFy{H2QLBMlSTbsGM{SKG(6 z5aT>9S1b6T6yrL?JdrU99dWn9gg7_y_K&O&Hz7XKFr4pDP)Aurqnf{Hl&-;l{vmo@y6a(fn&CGsiS^ts;x!N0f@ z+LD#Q&m?uVV~7wh+Q(>rcz+RbxF1tVs}S&@b0Jd~_Q>-8&h49w_7(cLyFa230br>Z49jqI=~8>_?y{*sNR{ zeuiP-y^kF1q?V)NIpR^;)G;fMV~9&v1G%QTVaI2Ns*Ql#*W?qp-GLY4q5e{7*cWA} zcTc7RxDgcgwQB-#`6Sz4n`_vIypl~|@qoQQ8SQ2s7JyDgc}MG*JmP7E%ze?S;8j%y z4`Xn=K~IxKs{-EPzb>9}7Pu*VZ?wb)_;szpf-eerh!?Sf72sDDwlge-P4I)!c@sPJ ziITgMxQ$s+w_e@8Nv4K5 zJC<;cyd(m?bW=jlXvKRBU$_ zvFG{flh9F{DRnM+g736O7?`g?hg`WWNnC(DLK<)7WCY@4O$tFnT%V~e z^v*SmQ@@pc^b?H#37*@&Y~Y1kdmYGlp~L;js_L_IgkGoTG4wA2efSUfeTo4t4~9Pp zo~{AE<`;;`EC#Q3l)5?yT+W^Rn(B52ef_>=_wHeboh1)1ieQ}eZ_sc0VBF7hHY+q@ zK3lY^6JKH+IM=Uus(Yf}M64W*J?x=7|CFl`>?xu5x%m)y4Pl8{V+r~}9}}<1DDpe! zl`FO7vA&bHvR0U3e??LJx6lZKK;&2Uo(sR1KUrNn-;Mg@^If%6$&Li;8Qc357U)ML zFyg)E6!L`8)IZ#nvA^t5*^K}L^sx|6uaUaqNbs?xym!FOk#L85cHm1C-q%L@d0>Ag z@{vTJu8qLIdfI84K0-c{Yrd&&3OsJ;I{nOR^f&Tct8*VkJ~BG$dj4Pd=Nzge7Z2E{ z;rK{r2=p!Ho7gX)ly!<5{HwcqCaDwO>vNGhR?vgTkQx|e16PDUobcSK2YRh> zd+?Di;xglO;VuW{{05~-y}`s@hJ`w>4HZr`N`HF zVTYcg*AWu}p5-U+KpG>9^{;X#xEMHO5q-euE$krdB;z}g3GCa*J$K|673xV>12)3w zG4Ick`riOAmzalNhJk18`m+9@0=($Wp5@YbtefXy)z<@Sz#A@?oDXV59QbNn@iRWJ z`p943&Avj+|MZm6HtbZR)zVxtH&`(Jk zi3aZg=R6pkY-7PA#u?my-iChm_GoZ=HgvYvBs0!9(yN?OK7rqn5gV}wMk4>Y?d7<5 z9qZx*vvRB-@~DYFT5SW6r?PMVLWA*<{7OB)WQY1Ax!Iv&;G4jDJ#7d0ruawIl|O8# zGtzHyk^!E|NU7Vt6$DQ6Wmxj>h2BPISUkFjx~i)$p8HpzzAu#Z@Z%)(DT!q$B}sH7 z>~YQPE(RY@edoEhwiom%wM&SD6 z3!j*9z4FgJyhIhFuZq0&Z{I!!)L}e7 zQ^(VhLe=jyKVsb5bOMbKcYXaHlHzt8`?6Vmk1$#yF033c zSw}vAsVV62IWg=XN-0P){0ZLa(o$Chp41)W#@q*dtvNh=F!Ka(B~QDf8TgeaO#EH- zHTK=eh6yI6Ko9rzY{>@>G~L%SJ&gGbd8M}Z4dS8CuJ?x{6yOJ1c<1V|UN>*qPqkS> zhj_2b5d+@$pU)uv`vm{f2m~#8dv?RlgRU!b9|Mjs(Cr#?L0!&fzJ+N9be52Tz6;`~ z;ZLg+p6*7xU1g%YzEe-dxcB0l`|x9u!*nlfSFvA0vEuWaHsF-H0=Gs6>Vm%*WiQ!7 zw?BI;uN1sT|7fd)C+xsuDJPGD4t~1qhi5YEwIP-&BH$F_Rr>tfez2RK(?TySPr`2Y z@9sD%0K1bGh^(dnf7o{+WCZyH4ccdgAA!3>>*rVea6Yyp^M#LKXPdDJ6JKyX>iy== zNBN=4JDGDcaABWC!>W=!a3Wxz%?l;iFK;1#FgwndE51PNhWb$tZ~3&N!1KH-WGA0d zBkt`JPt}5byU73D*D4O3f;%hH27GRPG3{wA?7cN_mueUIm78JsWq%{!U1na))Q+xj zYMEFj6}TQ1psrR8edt@pbJ8*B4!^Q?Gti(<)7UGmKS#XK6W2dI4kO~3?FJd{Db~1vf>xs!tQMZ-hbDhLmU=V zvm%G{6T0_>bJjzD5~)%ec#JwUnk}VR+(*Q-Ohw-u@GXP0D&8OPTz86nGDeW^oA&8b zmTb0=I8hw@y7=Dlq%$*-tW6Q`5O4ULQk*Lhk6)w2ha5_ zjKe206-Vf2!n{g+%0}Q3r>`2w;W<>UM^z_)Um0KT{`epo`pn5=_1?+oe?@Y^V(I~O zqH8xC%^srv7rBOTFX|PtM!94a;_!Z)3qv>0`=VYdF<X?YU3 znG?C-jC}y93yE)43bEg^cWhw|y8hGA;nRwH&FZ(v*{1C+GAFu$|a?R03$zOn@ z*MB{WA%~tw>htIc?1z-S?Bp`yV76cjV}tX!{z0$9{{GmHu&qOX5#uo|PA7cpDe(E* zYWj@~>|Zz~8QzI;c=R-tqY3ub_m23j1o&0~D{tSuMa%~Yg`jym_&l?30152tl;R`R z5ZKqOCF@5b4a6~CO;T5Z-=*5uO*{`m7vOwyARFsnV7i)foE3J}q@Yf{7yf$gj$5_@ z{y)=Bg$aI0d32)x4}LfD=KMv;R`42k9@l#GDH`w38GZ|%Rq%Galt>Eu{|19L`}d*F z%V-yQ&TjA_54+ggI0`5nf{eBPa_9_ZKP z$Z8)B|C?14z9$j{ zlp>z5IiM^Jb~_Qa9VdDS>)l%Q&e%SzpBt552H22C)0tp#@i21+=S$aFmUaOzINI{B+XB2o^5E}Db?~!tdpU}tC#ZW!x+AKP27aQ)$`KNQ zJOXWpMz#;)>Xn&O#a4)0>@M9obOv~F+d*0yu*o|@>3GZA_Sc`&JsfSnzHKLx+oYqWm0{p!|D01}*;@X&7 z3cnmy90`RJnKkC*;Gge?UmnFg-0)zhd<}i4_%K_|9?TQ3xq{Ct_=C}!Vjpv7=#TGt z8DpTg5&K_VQNg;6sDEd!f%)$CcVOt=1^zTok$;*AyhiCF(Lp)HKQnLlQG{R}gdhFL z`xWD%NgXkbdH`Bh>PbZ#?B^3rRDbFN{CV_xt~ z7U4-NpIdmYkDSNfT>+m~YInA{1br^{G9@F%TO`6~?J4HrfAY=${q8@11XKpDu1>+9 ziWx6HJU9$LA-c}}=QrXat}6Gz7394yD=k~Y?i^|-H;6-x%7K*vxJ?6zF^8V0w|9&l+)Z5`H3TBVhp{J849A7d9&ewcs zyK9ZQnz|2ak>?TbJ!&wM=0p6+HMvoTxVDFa;j07evSTWHniciC@oVk7R}sg~vh2Mm zMu+nRcvpM2za4ndhyZY*e7^~_RAmmsjo$8f7H#8XNYxayy^t~hnUeMFdY1? z>i1|x0dzRaNKI0V15Me5-eAPB6_@R$q>*=;u03nZ27a)i@PRCnk?#e9dxF5vHP zbJYe#kiY!O5%Q@YbsRc+kGXuoM`bb`yHqhx<9U+P?$E)`4H5f~;(5n2nm zTz?nMCutAxseIzh7wQ;??1N`{D-D5T2X9Cn5knp(xj2YY0Djj`@Nldqc)SUxpcnjR zBwa^m>T6s_Q$|u5{F3ynHAln_kC`1Ql;S~tK$Xg`7W4SplEQ`p_&M~%ZuD9i?oTOU z*r*Qg@ezv+>qZ{X&>j5>^uUW#1Tx)#&$QXv9S^~`_NUwIjW2?|bgx+)!F*+@B?HAln>Sg`BcgRDY@i_Qd zq7QwyV{(W4k*9R9RiPb0UjcWcD5hfYphFKYOxshy|M4^N(7+yf=VlKibHHDoyrK1w z3rDGCW_#Fi%`1v8YVhl+SKn3@!k<3c$DbDiyLSW(s_$FyT-A68Op`J#&d=tQX$QX3p=}UwY2>1al|&Q;RzXUmNPovS+$_ zVgGr~3R923e|+jEcd>7PcbVp!(k(#Wr0IQ@hWku>Rk!P5%5={A9j+ib3!GvE)FgCydoWx)5QK6EN#yb?3T z*Jm+~at}lMZAieIXj~NbGXjqk?~OmgQK!q8Z5GGDM`xMN0T=iGsGW?(`tQhIPt3!3 za&Q+O$pCM>%1>sZ=wfz&zOL;*m~vu|4490(vykq_7u_ z{-b>0qjtL@qRJf*=kbW#Gsg2Zf6M#u4DmzTQyTZ*hzs9bN-0`H+_<@$B=3wE`pP`X zkDJE0{`}aPccL7)O2b(`x9>+d0 z=@(u&>i3ZSI{@4fENt8y)kj@;freEXaF+UvgKsDi?DFlsx#{0{uhh)+%~Q~m=eYUY z_^6S;|4D711iNp&-t~7|7`U}xPC^AowQu@Cm+=2D(p>l~`H)8;1YLU|3S2&E@1uGG zI5Tgp!mErpj>4E!Mg=-m$hGJlJ^5MenqHz6en*lcs^$j$yh1w3_6GEd!J(MO+u(1x zc4dzcCkm`p8+n0me%s^L?FW8EO5`Y;4?G%{Q0YLPL0e|mNH_dMU%-u!?tJjLm;-f{SAmZWy+bdK;r`Y8>8}Fk zmgapvn;t;^A;_xjC;TxnZ6oI=@T^}BzbKp@ATHbUm7y8;rIl?SlL{W?6l9kCZwUHU zVc^E^&+r>vg09_jz~KkW8D8Kob+fJaTO1NUH6C~hM)%7~? z%f2MtCOluwZaup>Jhx)ye!e%r@pwrCIU~&DiMoal3?}efN(JM0G2h!lv(`!QBOfjs zoyoAk`jY>3(K{HpZF2G)IO4@1GM4 zc||4aNMP!4snJ`s&r{?PH_u&kM;*P!kKE3XQuMh`nk`56I(1)^Y<7XS^3|+Es{nPq23+xCix2j7B^gunRMbhJyGC;KS28w&|zP zlU9n4=ez{JSWQNcQs5ZX+7e+5>#Hqns(%*vbtag1a{~7@Ryrv51^a2}+a8_6`m$+_ zHol18Ikx-~-Fa{2@WGAcmNiJ9qEN!#b@qf8{pPdcG?@Q)>=G&gddM>H_{Zt+C*~`ucg<2T5 z44s}wSYIF7rf>4tKyMY?-!dA6eEV?sgjO`pTQ_K>hVu=Uvus&tl)2F>LjuHBjY5LG>E$t%evJNB9?R+dz4}8mWMVR1= zIK$xN*8yqpE2VcHYBRN{r*+xwZ}1p=mo%N#5&Y=D^Q2Q=B^Y;dwa3N%81E7u4sOJM z9!}O5SC)a>k#<@87EtHlw6K?a1a)sKn}q8v$P3f_IsEe@>hkg(zwgJq{onS^|9!gu z^buGeJQz)~3;CS@w}cX_O|{&9O>VC{>BXadxKY~(g5m{gQD!< z@HbGZ3i&i`68?jg$lsM|UvYQ=oQrAHSj>W5e^j{sHx&6drF|2Uz*n_Lk=NN|aQ^Ej zwgQFV_e`{gO~k=B1bh}w%At<}snbUW1=z1YbB4?j)CbV^thIw*d2yA`YKtO&ViNZI z2mI>ByN!*0Q{ZvMa$_X$O6E&G-%fulb>}S^TYSF%CzD&p0X$?;A=TLz@#Lo~#pO}J z>u2O~rrFppJfW9=u^#(~NofS$0$r=f41G#@>s1-)ypSdq0D>Y^2%(>@0Ne3HBUz%mg!N_E$Y0iGk} zLVa%z1>(&6X_W^NuWF1r*Z$$eKERT5GRxo>-UmVgS>RXRz0;*+2F`?a6_$P<2cGW! z?A5h|an$I(8o7!(eYuRF!Zq+#W*WLsO4P|4e!6}e{AiV@FYXrfmfoDq^Pi#r(0Lqr zr42r%ZDfDbtdF2KIQChgU%;&Z_FSUak%|xA#*J9Cnx7K znK4iM2-kvrGocsqk{k=}Lw)!ys|!Dg(LdIXi@tgt^Bujgr_B%JRTO2bhkOAoc}6fJ z{PQy99uo-x@S5P@uL|&g`nBx`2;h5nCH`zxes(5gCQ{||;W#+Hi?U4-$KExUJ zJ&b_9)|Ma>NVzCEGuD^I%=SI^#RMy5G%@_<<%R5*gr z*LzEPIUDnsa8$@)FL+jK>J3)gdyWJuMwe#36!g118OC@&7JVP&noKKEpQWr>D)9rq zHxi7A2nP@Q+P`1)ChDCD^VIDtgSW;#(LMPGJw0sGB=UR}93W5DwMERSUBmR1& z8S3wvj_+Tk-!XxXQB!#=sPYE*&rD+GBU*$y?ylV*1)lSub$q*nrx% zA=LH!UWoVtp7wSnep3Q`Y36RM0W-coZF4SU9d^eOQ+H2(13I~Uz^6gjnWn{!=R0`t zMwT!vg#Z86MaCWs9`QD1@M0kD=U~PCuLq%Ho)i7!vmFT?Zth6PFWk=@`McYe5vcQe zEp@9j416eofAdHT_|>;3M%BQ@FTBQUq&485UtR2xFi1i~Tal#bmKXq1; zB^9{9$@Zh3I|O{)_2H{^cl3`UU)1Zm1pQ4{D9pqJ^$PVFXRGkpd!}XAJ>Xu=xYYO^ z4XnQw`CaAfWQzvq^s$7#f~Edl%4q(? zQ`5}Be~@p>JORG^r~BXk-v9sY5ip}*0Rbfv&(QycgLGL;M7EWyyv+rrN^!M?AXP+EMLK>VK?dP^F*#DdTb z0Sn;HQbprP_$=bC#=2-dd_Qh)A;|Ruez4=0Vekm>WaV&aST}GnDeB8Y6>y_#swWfn zck9QO1F3$n_r>$K#GMciUhL5PXpQ|s&f7c@E}}Fqs(&ve$Aj={MJ|Sn{g(#bv(z%xocEa7#B9;6)JYbZ7G-T|LZcr z{t_Prwq|Ga9eiQ+`0?C)^YA^Rv8`kvqU>(&wwAS zNst*g0nZtt!?`~|PZyqgeXd0n`-{DW&)!15PJP)djRri*<#*-R3Gj*ux0ox|-!N`d zst@-A=LK1LPnrT>f7izDmBF~3RNgx3$b$QEGq)tC+Q}=FT3YS_UT?TwZv!s(#R(g= zV*dW=y*?kGgnEUi@-5`Zml2=3m!bwetMh=kW(Dx~=@8e)-ko`{8Jk*_g@1W9mHGpI zYOg;Du@!avFx%%4JACMSR6yO0~MkAYOTn+!& zG57FWE5<+eJ^#`U&RRDuW}bE?{JJzl(eVNG{qc{Fo1%WolET!2vjO`MP0h5YvHsQs zl4Vc6L44jPkh>dvc2Czj*Qp1%p4+{e^Wa0lxx9h$5~#cSWkNoR{+?mo<8&kFTjkjh zQp-c(fIY@<3IK z;gLs>pWUt#rNw%zQM<`JB#1hW%?0H**vEQXt2x3kAMYI@IXO(KPU)DmKr!5*-Husk=|{o%0Ta z51}g#_v{=9Ub4)*ejyHogsG)fJMg0pzgeT=N&LQ~@ue*4qMVDXi8#+;e;@;u@1`62 zF4RmfUk`UAq%*N>av{%nI(o%pDh72jir;qMj&>xpkVKp8O+ejoXdH76_|T@skM&pJ zOW&UGA5_dno%@r>HiZV%EB`sD!i74>%;PUvbwr&Aw&m=K1F*Zjfrz>mKksHnN2gYj}E&E~MgItiNI#yq?%6z{&5m~DCN=HmOtPF2-=f7I7!{_(?wz@DdJ#Cp=#%ncMf+&JyA*V#B4Q4IjLY%g4ZJ&jx=vr;IC320`0F_b`)SNV4?QSptZKUjx>)vntUJc5^tP?l z!BVWtbiLg7Ip8nf*G6r!fj>b>H+*oOHfC~WUBnm7Nw0F>d_SF(T zQ4o`=BzV%G9Ldx_*j>!eg`Iu;^OU-!2KmVMKayRyg?--LK44W1oSLI1Nw!&my-rC| z?d<;|9*K1lu*Y&>eWv7Dc!E>lWfy+5Xj?IQGZxfTc6w1%5|)sT07jPKG~q?h@YV zgL1Gh@)Ys}4*l8e@OSkJDdId=5l^u(hQu4~#E%kOBf$5eYkyk4A446+tnhrPGVs5( z#(u&U{OsGCum^X6yZ4qQrEothdPWJvUx8n8doHDeSKQdH|5CLE|7qnwHV-{QZvR(@ zjg#mnNy8dcWr6*@9HN=OP_I+WG1pCwI?BbQzbYMww{8!I~1`wlXUvWDc1*oFhb0LQyglNycOdQOJ}sln_ag3<(*cNM$bbxBCD4 z{(7(XdcW)U^3S=>an3$_Kj+!^y`Ht!eLv6@ccyANm?Lgq4m5OlHU%8(XyDhs03LD3 z{N^U$8}1)Mp-vLm7c?wk+pYuPTiCyTE#-%Q$YuR2l~G*JpMAXU_&yQtl?h!d;5){x zjH$pu=0e>c7dIfUMdtAw2R}02z;t{N^*!sioY>X|ikB4t3TI}5c^cDZ~rKYm`4Ez}i3x8y`pw4jl zO!$HxaN{nn@PGSo6`bW};(3VtyOe3wh4GyYnO}VW8GTC+|D5`hOD6K1^y?GPkqMpw z*Ju0c(Kq3;PfiK&k#$CNd?IwvS!p`MZ{?`dSh0PdBuhqJ)o<~3yx(2Qm&47ROxV}m zZP|aEOjIYS1{Elh30`Zu2hHHCxGlwaqks#spU^730Cd6^HJ96go4;Na^DlEo9UAuu zyJF#&?xGqZ11%n{q8{?)!3pMb4H=37+rs+a2b5JJx za{^}_JL|{X=1Qn#-f-So=1Tmsk}vLt&bNDoFYNv;SK`)ESs9hDE3taMDn;DImB^8g zSdnsdC8X?hPbYi260g&i88?Tz64M9d->rY_N~|wU3l)a$cQ0}vdjBSj?_=qkk2FYx z)urVJpPk@C-f@+e>k{zQa}OB-@Jx%WALq1yqdq4;oqGU2>Y~l1Zl^R7G4a6E^e^A;&t1{)pGk!Ov+_D~YFuZvTZ66;{B=Kfe$zUH{LI&-vRey2 z#vk*?J(Ylu&q2i&#k%F*rE?*`?GZn6w#fm{AM%Vios8#C@}GO}!sivF%#OUm{JQ-1 zrdp3K<~b3kIPZ=7og7f?h5Iw9Ab?vl8~o7q@TN--z}wI&#fSqRXayYWQN?{$EPUNk z4LD|hLuW-l{$H?CsVW1Upwh~*xn~f51>V@3PlxgQwAw0-0e8IoepIFcIHl0|ldfk3 z;=(ze_csEemsJ>qn*rA(hG_oky#zkng-*pa3jA!pKMgZ}_meyqxm1B)4lK`d#I4|b zTzY)IAkL}3n%jJG7vf)VNym2Fe@fRT&)>v-dfD8>fa*PX>hl*3Uf{e=Deh`N2HYss zzvqIN1LDr?`V@*j^Z;Ku<#rRqwHA3tQGDP1qA3-%UYwt{Glhc_>pIOByiu(1Io>Rt z`qww&SJ$sO@qF;Z-TOHWfsexO<(;9f$NJZk>TNP`(Q`Xmg%7}au?6W1zPMj#)!4Wq zFb+?A93K_q|83cp8KF3SO0dS>IQ{NsOU#6jcJY;<31x(gg68 zkCgMHWn6b#YsO3XIR9(eXYJE#Bk-R+0zw1fcV7b+Bn*eMWgs7_2t-}ZIRpOX$(i*z z1aOg|gW*Z!{XZ{ub~;aj50VYrS%&*j_cuqtb>ISy)aYzR#1Halb^PR3_-1Z+74bob z-yyQ&zWz?+`LeOtB=9WfgnBbn2C(j%y|6^8#5$8aKJXE7jeaSq(Hn8`hHPhycM9U~ zVwyE0)`|7C968^@fQNoKU*Y#d9Qal9-q#Me%y8ZDr--`+EH(<-h~G?thksqO#{C|{ z-?&*I?~)JVW20PU#%aX8+MgQ=2=MZew?qH=*b`|wDJI}ajLt^th#`(<>|ebu z_6mJ+{!B3k%z!6XurhYUI&_I7xMIlxUxA9Rff({>>}xw_mi?%!zs7JOQ3XCstMG7N z;Ga5Eb@~eMRJ1~;uE}@d`(kLMUxJT$oj)({fa|+KKJnZQaa@$A*f@v@dHQ3?tHs0c z?<8!z=wprgvDmLWuYqrRO%*1+1f0vqtFZkg{7iXo0&V{FwTe3^>?Jz_9YM%bUK6;q zH;=00A#kcx`v!^Uz+DTwQ*V{v{ESjvhaO;kUhvi8u~rrMAMZD2CxAyKgzkCQn}Ju- zwJkA6{I;GJVm_^o{y44c6E?`M4iFI^aZjgzigG%Yl6f)ue z>)z4(z=ziw&5wFE126vKs*M6}OtXEEAo~G*u)GO==Wy_}vEzQRZqO&)IHoxav3~bn zUqV9%J~Ew%l?2ZdXmBLNF913kC(pSm;E~rbHW>j&@$pLA8x6V=GZB5x42`Zt;+8#1 z7oopB57OM={lS%}VdLn_dGAUTo_*%=v&NM;TwQnM??YFDQ7_jzBgK_)E^3clpWsUD z+7}T=f8UkpGN0T~ROw0x5mc|GCtQg~b!TrgNuln8`_BOnd-$SG%0Abb%{W_e~3$BQ(s^w_%t>oWB>;#L;Wfib~x*&dD zR6E1247`?Y|3gp&I8OUzs{1_R@*8fef-Ib;_HLTdx^3=6^gG{*jds41y<<8d0X`-DH)a1uVeISj?D-)B#G9^uHfs;mi#^l){H+VP zK>TS&$~^Gc^gbOcBk(A0@#gYD@F@>dwrrznM*eO+emo89%!seb{1vxQKXmr5lNI9V z(t~chJ&1!#cHLJKkcXdSihCbIJT2M$H;e*&Ahg-|gg@fqqslXjS3RH?dRL^IA%i}KQ^yI21DE}Zli_{jg?M{{FPp^%IOWj-x4k9wu0NhK zU)@pPXlt{dCjovZ%7(kHoxoWp?@nj|w^)7rnV*g8aukWo^ucwj$G)`m1RvBSF4))w z{d7x<$na<2$9;1gfqC$?SNhNOG$W2x)gQ^GorO;|C_HVlAM3#44_ZBlt4#~mkN@rK zT*E{0d=5M|s^IPP%LMo+b=NX4a4egnj%+3PnU;FFZ?#zWjyk062?0;V`sZzMCh(P8 z*RLy$KaoG2Xa1A}Kh@|=MWrGhYaMh}>cIK>$x#ocGh-i}u6_k+tS`sAxb9xUc-shg zzLF?{48%rPC1?xiSgA7?IGI0yKEETrrV>2^*_~{@8QUcMgeuF z&fY^m*4fTG?5@y%j)l4&wk8ol+26)i{7A(129KHt;60T3OfBf(%SqTFG0=zlwGCZY z7)HF|j~?3fN(}ky`GvPU5(elq(K=rw4Bp4!CYuWr^h#rcx#g3X>4nm05KUGM2B5T@|oz7qOrT88?_F~Lojz*il=@L0Ug zolM9@*&Nzw2Yl7M;rt8egHC_TrTKnCzw8ZAyb=rCT4LTk1)kE=K8oSS6Yv~fPi+*> zV%|v|i4+Ge-D-3!3Vtn4!M#PDgVG z>i$YUUAIWZ`P`B6Fc<(o_``@}QVe`lo?wHrK6J_`(x}8E;4AUNA}=J~qaV>?X-Csf z__;`8akY%VBdKmRXTT>JOR}EfSHS%mTs_IA3LZ*i^>L{*d@@frvswUu$+4tvtVLb# zIOo^8H=XF4z_N9C-D}{hrCuX%)ED0K8MpDO!F=LSPN)VhAGqdq;e;%BZja6B-j`8_ zadiuSD&oRToojJ=n4cF71SHP@SH1mKBb!43Ume3+R_F;nyU5G25%J=}>b?p3Oz=mo zwIa;G-I~Y0F>qo%qmX+_lI;QF$nwlk3vilkcJU3LDCoKM6-)>|I#-c9u_WORfN6^vq7did_rxhkn1qX~nNB1miD#CrnR{Xt+0z7gipI?Uy z_$HuH{!ASg^m-P025bdR5W3;aC4bQ8Alc7gGagN@O?VDt9b{yj-jRj)_aoUNiGurj z@#|#PI#cY&5Ld2r4}7XR*IN#H%=d3R#0yiYodK9~Ku!de$m z7w(UatI%LsKeZi$}K;I9)0BeN}@Bc6o~e&a@bBhh~Q*>(YXmhpt+u}k3j z$&2N@;6Dzz1v@{C!3WJ->B7{RTQxf+*R3g2dgP5kWm2!BMB#puZr_}hg~ zueKtuOzgelc^Bh+E<|jw8RK{V{89Qw;9BM9SIobvWBl_17qb~KzWkQdhfYB!oe;hJ z4^MEb@Av zr@-(lvZK&Zu2=lZS0NL6Ja_Y{2gpQ-6Yt4kWeRcQ%3a|-Y!u@DM7+G*DvlSkf$=-? z)IIv6!Hd9KG?ToaXFHL1>|du&QIQE@DxUyLd~daVcDLb6)H~{J)(OVCA;wYGK@q$l z%b|jsM`OU3{Jn6U5xmT5rM8h7bS^GBzOY-+L5-Sv=V(K&C#o2Vp|4Lt>J5MBZd?5Z=oryo@#C&Z-U@u~ zty8eBoE7$!kvOr=S_k}++!<9#^hIE7ST8!Xl|+P>d~VW*Pm1*H`7tL2645GuZrknC zBx17q;|{f}B*OH%xPdG9Cb{PqYz~)!4->e_nfDxz77n~4FG)nfU!y5K^lueSI@G) z82ebR_?JA*bth77X>6`$BTuH@n-G48I{kCuAyUYj%l$&v*OT3egN7bT`vehBzIP;E zYJx6Cb?a|mG<3Wxr}mXX=Sxxi!j%Jl*Dc!YH<sQKn+!N@a>-l4surBvZ<+Xi@*IOBMUO03BM_pG` zJ`B8da98YeMqEFiVbH6WIL?&s_HVn8pPZ=cyq(?PHxX~x-)j&3hO=dU1UPHO_1V-V z;LV2So(Jid!kG7xOg!TOG7he2HB=pajETC;m zgpa>=|F?Ak;GgO!8WBb>Ks`S!T17-*4rPxSo@&Ub3A(fQQtc1ZBfl zXSIE==x<)|$YULc3ie?hRkFN1AqgFgP_MGu3|{E0?OxId`ab-s(+|u=eV+?iuk0f5 z=5^`zMlawy=Syz~!E37az3@E%9WbYCVe2wuOnH!Q&m>ns+VfYedkuhV}h zyCreo@6uohHpG1~6LzBa-~P(c4I+<)S8)D}`993RGaTQHe>CEL41e2baRU7L`ML7_ zpH!jWZ!5dB8+_;^riwU=W8h0GT}pnO#Js)!{c{o?4>O5sty8f2$r#6x_c@+mjdfAX^0TYJM@>5wyRQOYJ>j!wXhnRB-d_2{)&}dTdNIpK z;GLN+Y5lQ30-Q$mK-UJmQ0s}p7*{*sr<`d&7RUEMTNlm`DmRpLY-;_QEZ23otqwGsHw9RZIo zO=lWwvEG`QmUH-o{*4i@zs7$@U!P`WeeDtCF@O7lsW$Y-e6l}pcNOB5LaydE#05je zTBVjO=z^P%*tN%kk667j9D{fyty}opLlSuHHgP}nJ8+EonabHm;NzPJm0<8o4~A>3 zjKL=nt#`$jfVbEkq)xrO1RN0}I5HQCdcE}3s50QI4FUGFC*h-TzIp4)zq+7Jmdr!_ zz!zWI-K+Vhfx~Rls^}NM>&)M7-7yNBhY z`~4$)Pev(AgflPr5PqflZtz&^(|WQs5Kk5Er(Eg=4?o#$nLi9&@%5LA#DDdDEp!(L zIJ=Pxmj969 z4t!SjRE_m`ee8BM*Hw($85`4ATzH*y|MoK( zhqy+FkOTMv{TV0X7<}MWM{-U{L2n4Gl>e~_xXmn5NNyN9(e+FAqjBh?{c&SnN;-)s zw+tmEVEkExz0Sw4AYVMS@xH%_LcEd|GW6U-As(11@ae+8v~nn~WabTgV?2v~6Tnx2 z_Qh#i*vLeRs@0vf0N3!q;RMyZ@S$9eAfBL(ZD;tv954AFQY*5l7uE!j^z{ z8X8HAZQbCZ=u`z~{-R#+V#~pQzNT0ACAOVyMW0TW_bRri$1DGtQ}-eic&uT=z>WYC zVKKg({~gB<7?jzi@Bn)2`K|Zp8%e~l_pU7^W57w%Egug87Ya18jl|-(Z>G+wx#PJ> zaE6xUSJWXyWsfGbp)b~k*_0{ZvA-gko0M@rMlL6X+5TXE8WG+*1V7d@dl{)rWZ=j5 zyKpQ4^W(wQ)aOTWz1b!K>8Ze(Z+hbbPN%^C{^MYI4RBVeEdPbS@WE53+<>efFFC{9D8UvD>E47w{N)dsD-s1k}gTis@s6L1JsKbxj=B5&6lH z+of0G58o1RlPe5Al%UXtRSoo+J^gx}gca~UZ{2fISFCgFmt=*(18r7W=(hDoU$W1C zZpwf!$~(LmAcr`$m-W{J)!X2Q+5!z;N1*SU(vDq^gTW)|dfwtVk9{(E`U1ZJPpSES zZ;tiFI_kvquSv43T(fO~)m)(xKK z_0hJNj~k9Z-HPL_&tlm2DH1%`?OPg^z*k3Y-F&jKo{hib+h*T@KE1rTFD$z7e$n?2 zQxIpP)(I!(gLmb-eq-17@-=+*pPPBtuIzuq2qgV#9X!+tKP24|Wuh1HW^>Cyhi=^e zianC+kVkuT)jog92Y+3jMvl0Pb)i0u&5JPfZ7|Z_JcszPLvTva*c3j3ou%~tqV9y5 zsce$KBmLsz-j?}egHrH2XVX(&ed~sAy-7ITV+=f(h=1S!@;EAZPXNtg6dT(9t zfByjA(;>|>`N*dft2({rIn?VkoSIm`dN+wLW1T#FOEZOkIYejRUyV;Vp@HX2`D_wr z7~#v_`||l6LHP1*1!VTh11HrQbtY+{e|b})J+&IHGty{B82Asji_?uh_*~xWzORG0 zu1@!Rdm0i^=j?mnn>}z1-@}bHg2)e2vXQ;1SdTN!eo0CS1O5>(xbJiudE~SFfGVyt zlV>*m8=iZp3SS+;ID9##;KhghGc{wW84CSPQRlDIAQ`&fm72cqc#Jo^axnP}^pkJX zA;Lz$pP8f7RQB+(iM?=HI)^?vd%scYcLO)Dh-Xm1n|$cKz%}v?zMkeRdT-!c7TXYR(0X*Tw5tbygqqRAJ6>+Ux$3yNg-xz z$}ew(o~M+#_2+amnTT&W7D{B03F?9=vQi5C=pV>K?eM3+)l=I0S%FNr6!Dk@AirtM zx%2F%f$r*-&*g#Nvvtg@q7!^bal5Oipcv`|sa%}uMW7e$Z5}i>h0e<&*WsBB9Q}^# z{BSz*v(Trr=doPqW&u|>BnuzF{Ci#6B(np2rT*Ry zx)~DT;P>>jh7#(f9FBNS0vA+Y?LKEdOCr+VO}nHwkciIP+qMW+0_X7FVlH`wzUA*F zLWEjSU)P}Ep98)~;nl^PLclE){t@+jX7~s79`|Viubqvi9UY^BUvADLbpbpQf12q) zDDVzX!G|D2{63p}Vq$^^pbvK0Kk{My*H`{K(>qzrC$D4cO^;xH*{*I#*pK-Zou=f4 z(eyLj z2Y#G)UJEt7}?e&&&9vzr}?%m$9Q>aU^jxr78!~HON*g75Si!`>|CoWS^*Kn(`{N^>R z)0pp2X@h^M`kh9x0uOGvMgK-{J?^8EJoy87-h9c6e<~X|M_iYk5qM{mZ+UVrbh2)b z6hQ;v7zN!tO1>}fO-qo<6>sq30`%hBv2J_Xcr3ij0z8ywbgnpfD4y(Fajy|~BCTw@ z?eYCYJJYNNzJKskT&5j(%-lJCJu~1KMRH;<+dJTwvc$6H9`Kv%qrR2`&$t&fTvP_0 z`QH%Z*RFAG1lC62e`W;EX&pYXDG&PzS2OK3xR1ET<=cNh4t~z@w|Pa^!GCjbIjF)9 zpqV21G2ae;tjnenE+){+hSNhdpp)HYYnU3B0bjrM$nAmc(91R+?bhXVCnWAN(9=-C z-#!-q!Sx5?c;R&YU*IA(OXF?XSjYZ-ViNzY2z~wxM5DJpLA~AGs&$v10|&VZe>TDT zmYrpPWa}s3t1-=MU1y1@6xz`TtfW! z8f!NvfoJ;U88>7F-GEzUSvl-D;^~%y*~w<``&6rz{@c&xmS{o2L##WOUKVGT*`U9A zt^Wr;=mO%WkJRNDfzOvOw`axYGtI3h)L2mmnW|A((TV;PxnG?Fp|iOTa4Kbh?>R-; z7UJO#Uu<_IO@9#dH`)iafp_405(+pjn~Q!wRRv+uIL|vY5=WTdp+Em) zT}I64`(%7%!yL}{W`JSo6D8Dt+QlzjO+&q+M@sQGKJZ?21+5ahfJ0yG4sjWRUb;Wt z!*2}r2*)2PHr^r=H7uT)!qsHr@`tmVwfcaocKHeBb5V$1|Ah@A+7u%9Pu%iYAO(Io zrPDF@@p#(!t@s@Z5kSBG!51$I5q#$7QC}MhA#htYW{*9Eu-@BOq~$;%`cpf@KjHIM z{bebVf)v6gM6sXs$oFgktCoY{pK`g?c2B*+I7Pnn%VdKtX!YZX2DLj; z->K2}Z$1=-9q>Eqg}xz&!yDZ(4(zvRnVj|j?=ywpiE{hr!+RN=#|wRSyJuD%c%MjW zRV^2czn{?Kj&}Th7v8^mWx)=9G^Uw2{2lzwGr5ZofYU;_QnRLiLN~NM=6n-=CEsm9 z_jU1kZg0ci4!~CeJ2D@b08fQ$hMc`IPa^a;-{Cc0A`x`jF5Btx`rMmy-;~Dx@nwQq zPr-+^AL@6_{X`<3s*hZm06tpBZeCu3->Z0*v*2GpB(|m9UTW&l&mvSq zF)xlJnSSX8{L|_{1Z^^sia!P=DK$?j`yRe(aWw(Wf&IUlfk6PrHf7opEl=f$%%2AC&mw30`!= z*hD*csBybnR-2qqzY)U9`V#Xz%|Cyw- z_N{9p@V{gPK3v!!kYbEH-Em8#20E8&EWhY1^7Z(*YZ(cA&ae_q{VMdn;zWOO4Po%( zA5sp*Ag(sEZamP*h)276))EG+A3J@%Z3V7cQk+a*pdOU= zW&H-8pO4X}zXg3K4~MB;c#rk5d2ggmANCh>oI5czhIoHk@<}T2faZaH(YlS$5yOhg zq=CN(4y_^TeBhD+zi1}p(O^RBnZ+0IUL)y=EBIbgg@L+|4zA;yqE0t>wYTr==}K;) zFGShUOC#{}27(jxY*-&Ri=`^7IKux>+E%TL_4mP(m&A0%(f`YOqlMiP>Xl4=*ah*u z7ge5qh`EQpg_Z0aWg+OJ{pDcmB6y}F*Haw6#iMS~@>6KVGvJm4{)twc|BbimzZ1aQ zU9rgW^&dgqIls#_mQwH`L*oXo?2tD(A4RJ2;JTki4>cgqb{|ra8ian7T5|pE2>6X{ zObtp8z@wPv?6)h$by4~+2T_m@HuqOPEQOEBQD4TDMU+gG%xKomU_C#?YL?FP7yc^e zSUPWf?@RSZRGbHZ125lt69K%;t#-7{RfbH6GW<st+@5CyAoL5m3#LehoR_UA`f!`-q zo-OrM;&&J{RbU3r;5g&pVQ>n(<-3dV+Q6?y;|5$gD&Q~MG&Zf{g6@~(Yjzbp;cDzr zIz8Yqmd13F6$5mzjvB*@z&SrzNd3j@(U-~eQfCnhcp5%)0|RFGzCY{I`~N~8aeJEc zZP3Sd_Bbv+XotR6oOGxUILI(-iY^$qs<85A4ZNbhcVVyuze9c$lj$OG3QfkMwpWBZv04*O z)&Sqg{diZD)Qmg=Z@ z0?)P7lsUg*{jG$yx6S=u!u+HQoi@ zvEV=C6WEXZB>eJ4fvc<*3}bb`L)>cmeXtt1>H5}1(MY_H+CIs7XaV^$z``O4dA3boCGr$2{Hfn6 zMu=(nWDgzbdE5m)z_z8R7RUc}gq{@p3G4I1M;A8Z{~M?D=u@^}{e0@v*ImGcEMGcV z;}OTN8nqesA#PvV=DptE7VFfC*4Kvk|A~)}wXZ-2ytjz`Zg76Ui(?oY?Th(?%}DeZ-D1yUp4zm;d&KnbOc2P!FxR1_BZJ##>K1r?#s`p z$K&1qhZgy~F`?wmv%|>ei&kAPR!9W%E(2M|Q4;ZPbmKdE4xE4EjwyWu_N0!XZ5;QfOi@mH3hFj##N@W!B@@!$QfOwtD+wku>n*?^UM?^(SoI1z zO!u=__F-7ZpJQSZzKs6xyPrGhW+T6yA^)O<4{Ad@WB;jGGSOWTqb|&O1|xi?7Mc`JNQwchwT}QV@mE(I(ybkq95Ti$Drn9`KUQ>Uyde z3SoFh?1q;Sg-D@J`V)md2!B44SX}rh#M$dRKKY7L2vwR!rD0j%uW0{+J-}CNCCi`F z!_W`?b~F8#KKS{z-Sc4Tzcp@8-fo2c8n4Gyn@OnuTjrKv@j=}K zjnCg{%$v5Dox(%6fxlDShW_mX{?}V_eJ5UL*wgsfHw8L%K>fxPjMvu8bI;=H;dc_e z_i*GJcvI<=ie#*JqIkZ(4m*hc`_Dhq<(xp>rGA%erVV)79@^PUz(uuJjP3G(f7uh> zwDCcA8#_gEz3=Z%bS%uY7XtTm4?mxI84kTKe?&dHfuHQIf}gDV5)wlUXWY88saOj6$lWzN zr2+YU-p^^$h6=tC-JQ>m09Wmf9M4&WP9l9sC{WTHJjjiJx6vZ#i(FJ%kTpdj3}Um$ z9mvZSlo(@oE!0(w6CvD>fh#lFRz-nd=cq*ohk$1{tqzW)=Hpr@4giuNK8 z%}M?dcil-QbgNqZe3Hq;X;z+{jge$xFl}jew>p_%X57DyNtjHW(Fk;KLS5ejn#B1R zdf=x9Hbiq?ArnIs8LGNQG9k;$?v@7rC{J&qe0d*yQl_+)+jS^}Q7ONels<*{+j=p= z=_Cd9jZY0bPE&~4k5?~F_)v(iQDILMqbNkZ;aac#)E)RZ8Hm}{}b_4x3>u zv5^7(`5i(X-VVMhZIph0JbX_{0+Az`x!|t`WMoW>vHzdK1MSi;B*H0CK&W*+c*~Vf zlV^bcY~u_{U4f@~jwJ7N0`3}3THN(T7I^W(?R!J`zjA0Xl{N5NTE{pm2QB8=Hl<`T z4RBGzrma`_fzKob4C!>y2lu37){;N&s~s2o+*9#Bjw-$&@VJ+*+RD%2@ldyF@=oCM z>{nOU-N5*0!cu1rd}T|eNV|L&>!0DBG(FMy{QiwL+8J1n$jTdT2j1HK^SCn$);V$S znZJdv07o9T<)v%`kNe~Aq>D1<;iIj*T+rVxO>AGs4ZbNihO00O_^DoCds+~DO`NXp zFR*8#E>1D>b8b5Lr8FLW?o{ZxGn1DM@3|AEhF6n?@ffX<$rqLEPL!@1FV(_tuxv2< zunhQ0CZMV>7rI`f!l~ecnD_tJptSbl+6b(Tz}g7>2aG_twd>7iz#~TkWAfx?QAZ_5 zBdhTNJOW$CG0vxm)4ck;j~{>sSpKra9FMphZ(rvf;YR$q8*$d;19cH7s*6SOMp7RxW(0 z7(?H7|1G>Lz)yuc)^$|@SIzgOcv%AX?UNPEl13g_+~LH=0(?^B(e?c%a8C&Ngl*Ow z_=9r;n}&WPe;D%%IDSQ*sc@A~ZwKC4IsNSQYn+$-DLU^e_dDWIkatw9 zayXG^4mc|-%)@u`Ss>`?suTJYMrQ1JZUUVo`l!0~1?;;Vkh*T*1L_2rm%ke*q2Iyl zxrge0WI~(eVcTu+LIu}!rk#OXD9>)3eGeQ(ott&IWr<7_F|3|s0^aHRp=5VboI=R6 zi75vT(kq+@IsjKL}@lD8kArZc|70Ze;;8hjx zj{**1m~ZYSBIoVVe`(S}^^7}sph~Y}>&Wo+DQOxCgHJSJ?@YpYrRmnj3;)k|ws2OX<{(RS1 z3y%PgjqunC3MT`P=|(lb$|DiSv+8eVLLcNA-FRUa9q`~0eO49$%#&Lc7KAX){{mZu zu@HP+3+g+r0YBaD&+2-)3A|Qg{!AWl9Q|d5CJ8)#XdPK}+=}@U|Klqa=GFR`7{Q;w zSCTsiq8qW!xmCUAfJF~{_>;of=D1&`#uPrj1+N_7@8p(^`{+ckL+R#1_yQG&cE5}P z?i9-y*SdnfAV2GFZNhvs-9GZ71@~{hT1TxM_|`LVI&+=4FFhn^`@&xVhaMc9-UFRE zqm|-O$&GkW7R(?Do=evG%G9tq`i(G#Za)hit5$R7U~Vk>Vyt)a3(A7ud~&~hhu(*j>9y_{2zS>vz% z12V|kC9I9W+6er=MqsQ#U@UPr`o0)X_P^&s-7>G7HxqD7ag-oKRUdSi#y~O$;+2MJZ%}vz|93pr(_x+qKe}A!bEa_gAz*I) z@y-vvsxHgZdclbMsw8*GJHR<_dL``eKJulUi)Vpsrpxd{Jv5iA8~`p7v5b%E1#bFrtl&%+-hZ&|&@gK=eC1Zm3GY6^?{rH%ob(fU zc-l-%o&o;auCn~tp>qvsa2!81j^EY5Ry4$pg|4Yq2>jBA z7kY!x=UiW#iVw+Ai0ga~`J-z1e_eCTycUJfOnc+esX-wkhWIlN9i|XR`X*|(;C)dA zE~{@u;A7u&BT^W+C}`rA)=}_L0#l?znmZ`OIpeyMtmr#sC8|>H4xDsjuVvEjDez6F ztWVHAMSq0J;{mzQD--k98K%P*!|%vs&x+s2(Z)_K*bQ}zN}?&g=g_ZIc6dArzl-=x z#+7RDBTfSDUY4NeERU#!W{lI8zb6{ zXYQe2Ja^K}nKabrU1;T|>qTFt$gvp)_{KfD?$c?*e;!~zrIiEy&M}iG?dTg4(Yrmr z%k3%lg^7$Y&AJOd(V8#p1aMWg>`ASIHRw+uaiNd_b%TLAX7Bc~fk)!a4m4rK`a$#z zYXuc>_HeLbBzUX+-<+a<(qMi%llh~zpzqqdkPI6F_(@pH%>(DX)v3#-;sxdlF~=OX z1YFNp|K%ee>iMHmc+!CryGyUEEBb-s6DHdeN`bqdh{UwUqP{RDqjeCtF=K=>@$ddn zW#zabfpIIA%2tjy``5SQa4ww}>Td4{bDn&Fb%oo7BIORuPpbV_|Me%hb0Uz&5j^eN z=K2|Kb$8;F(b6+NNAyu5nG4ilUare%pk4qUxJW6m<%W*jb2chf9lq~#3`_eaZBbu$ zqnOSX{8W5r{%|R=#vlE^;^NxtYa_5W0&64iUmbzVzjBT&>_a{nZ)dKQ)sYn!^6d z8nxfsfP*x2Y~nPMps%(6{TLMly(5OsTLXDXHe$=3aNsPJxRsoI@SM%2u6&xSLz8rNsTMjKCAMJd0 zqizH07%P>lUjzRbCzMyM$hi|2E|dp7Q-E)_Xza7cUifO~>yD9-|N2ee(+NBc4l8GIq6K;Df!8ffO{>5B`e&oUrDFL(;qBtzU zY~NlA!Q&!6SpdAm9QImV61)=EyQNQyz%{0OC50bwfaj@*iDkz7cQPIxxQ@s7N56a> zgpaD+Zc{!t@Q#a)$LEvVz!$M@`OA*}2w(g()+d8c+9vd2p$Er#=|w5=$Mba0_#@1~ zO(*0xRDRk(AuKp(-rj|NSN2M;;S-MAo-AO#noTD5YOOc3H6;_u4SSevpg+2fc1(ZY z2)|d{i zvm)=wlkkhHe7R`e3j9-TU0`zsKJ&N=!@|w*O^KwLc16QCCGFH1cpUtbP&R|m<}eZ= zp?1SQqLM_+s{5xH1DE-E%CG!EU#mv}pRGi}Tj^cnT?|HFsA);dVf)|cZ(i?^*usN- z7Yp;FRW0C?%8^-j9JqRyY~PjPMK@yS5JO@U=F7fkUt2l%!xyHZuWX3<-Fk~*;$RDW zc-aYWUSggeG3rRI0{#)drX!UL+%&U4v3kh?e!4K}7r&uT^7>qtqLM*9-b3H;4&cUX zTR3fG1K?99^wW6rF;4v%zZS3_VBwk>E22f+YMrDajU@UsrRncb(}qt<>8x~tCU~Q) zFAZ|Cc>PMB6zv|=(;a>~UWoT`OFuiZD6@u-{;TnC?el9Rur>l~Bk}ER+|HT zM^m@&i31)hu2bK74S8t#{i>1Q4ETT>eVcYcf9umvnEP0P{NkePAcQ<-#`rNi3%pgO zQag)P9{Lwtis?C32;aKbGpXOtPzSg4>g*`^tnEs)6H?#@BxT5t{K01xM0v40EyqhoeQ+zH=T z%xPWFJEG1%cD{)B@zozbxr+Sh(xwnfAdgjv3SZ=Qhdy|q-_Qm=-PL7P57h5TM*j@>1bwVInC=7(_RXX1O9*`Uh)mqzd*sAhM<%XoJs#u6zA%AR zzJd2=@Z4g!Lz9L=q~0|z(L-MYiV?#)6M72qL)>$RF7!a-JIs2g7sv#Q_K~(aM&PTg zdD+w8qu74#V=n^kD&h1#X7~?xDFzpeLAUGVf3-;$I^DXQsprRPP*+&e%5qAXOnm!b z+Vk)g`Y>J?{(2XBPK+dPWXL^tVq^T}@iA}oCmIoNq{r|5**4350=OXgx8q$B@Ng*8 z=6+gh^owZOp`r$V(iVpGVtK$z{m)GzI(MUCr`_Sue(WprYnK`W_$q;uNf!IS7fA_bS&o-u-ql&_HDeyzq?_Ff!MqXs zVl6p_$L+UP2@&|@8ax%qFWOPZYIH*)<_Yw^SLENDi?HtuJF|)ho`-E*`4Wuv!p>z5 zstgn8(S7@@!^OcjsonK^itA?8Bp2GKfFIKndFtQ<{XA?}{RsFgS&=-(%>`H|sM zjpN(Z{WVgWK)=sVky%%8A5EU_-q%ah6CNN1uhYzqJuq z8-cYESQ~-=FGpZuQHW7I8oX1rpB!@<`s8FkjNOI27@wLvnuYvP`dV>LvJ&`*HsQ{9 z=wx>EkG5F9bt5XatGOQq?#T?bB%VVbQnD)OIEKfL!Vf{M&=2qH)3KkZLEYTg-0mT~ zZx@5}>7b9$??z&moK$aaM1J6S<8AS93Va8u%5-TWfJgA%92&I*XZ=hSjuxdgb&_?U5{D10FNKXw=MfxqH^ z%yoLdnmf@aoEdN(_{!}}iZRJ;JbvKzXIQ!u0NmlSy(T)2`paVXdDI7F{@BDevix{R^ zGNDnVd2f3snYhi=$Nvj`4E9~S`LqlD%dhp^p#KhBG{!$|G9gJJ!pdmMCQzrB%-pbcbTdp$i(t2mC|GAlMd8BZBo48n<=!AXabJx4^R>~4IC+YjML+MOO9Ff+*5Usmn?FtL1rC0toKy(B zWcsjv8x?#@FN4p7mjMr5l&;&o_ZIq?SErjtfwu~a?Vy)He<`M|;Xa4(nDIk}+z&s~ zZz|y(&cI>Mmh3qHOrlTK)WPc?B;X@bQ;AZ(20wU~{fP7t@oz@E!BBiurM^XeM}2Ujs@o@J`KH z#$!qc;bRgo;c(p#e(EBjuu%j4!3Y(_=cl1}N^Cx}^E~#y9Myh%E(ZHVHl@tB0cR>j zz9D{Ld`cZRF;Ib@+IZbbjm;bDiBsn8d-44L%bR}fq}E1YZ3NavU~L5c+ee_6=E0p& z=owS%XOc5i;bS@|G&rgc|GD$S^c+V#mZ|p&p97!7SoJa37rGFg`MEhS=tRtPo0r|; zZ>K*zAA$G19jIaFBOxCe3<1#h_!~UJ?&JBT^@Hsrz)AYX z+ikN@KbSFXJy5&~zt4>PPR1uy)?)bcn_Cs$!M_#TC6GJx3;h-Z zg3dXx!k^NSWz{Q=epjRq$E0+DLwI>*Zu_Et`0p#~?hQB(pM%%)&}VA%I<0J9Pcm_& zK;i@CG4{vfDN2@}AQJ-A3OY&9+w`h52Wg?VEg#oAOorYjq1t8L0-O{yFkkBepHjNm z!JtO?&$XWqFjnIK$zP04$)V5rPJ2fW86^tgoPOZ2A$(Ea6`ym&z=u95#J*1#`^s1y zR5fMGArsrL+HB>UML)8B9?K?k@MGIgzx)c^a7xJ4`i3=p#G0w$HQ?C_pYeHQfmeGm z)n?NST-7P$-+kHy{q&gw&l$t_RLMgl9tS+UV@|Sh9yt0}yR%#Yc$-C*n;PNJ&$@oI z{I~_2V>tAO*N+1{iO-#mb4tL;8~3VFp?~IE_3AIl_eq4yvj3)A>Dc!!hVGm@`b4dp zF&o??iazTD7ON&(z~_jwKYobU!^1aKoJIeF5HDMqY4A{$k3&+qT!Ej}LX7U!0kGO=))Y6!1ga%a60;dQ$7R8@xY;KCRTf0#|_pB_C{bQT&ISI;O0` z@cj>~vn>R`D>ck!NlF~XJk7J9uLGX?Z@5P=s?g9_6 zb4U3m~6G-_DC@1D}=Y(qY~*>P(AIB=Cok;zy(@|CLL zt-CH-*pJ!k=3=T2`ZeCta=DH^ha9v9^4!2--xX~bQqs{M%QNjJ^*iuWuT7Wt0}mbQ zGS}?~|G=~N+=h(L(4CG&>l%X}YfX3F-h;e4|00_540=@Ssz(hEa6v9L)2UWG&J7=p zG{{B&c9&1`<@36Y_4#Q~59F;oE9F&poq(qU=TdmqLE#2 z$zk+Q%(dnTj|UFX*L)ZSU2poumhm!OGBIPgqu$dTPQHb!=J{+c(jm&T`gJ znZFMG#}7#TxQc$@5&~12$M8E|bK3IW9k^Pi|FBbs0rur9(eF0L{P=NLKdDj%e!B7g z=uWa5G0~#du2ce_9Gd{ib{6=jR&}OU1b+V04skOQ=*N9dv(6lN__zFsckUPTMT=w3 zjcoy6>U*L3K|6H7tvBVDfTv~;DV~@FKDJ2u%{qJ^{Rm=8BfQY}iK~;S^2hvhy34?| z&%up2cEql~Bd|6C|KE*( zZDhpa3i7EMm3G{yGW;E(k}4_Su^z{$*?NN)kc;g*TXY$`M^#45|7q_`->F*IFrKm5 zkR)VCnWqq)PRbGz31O>fXQ)iuUW#xe9huTVqRc}ivxqX3A)z^hN(qtdgo>1;cyIs0 zIbZ6$>(jdA+Iz2c@0Int?&o>#=a1Cc{lY7S%(7=D&!%0iBiloRc0z{GguGA#hf@*!zO->X^gJ zbl_$nH(_VrhmjG~2`|Wx?s4n#AbMN^l285ZK}715G_sJlzRuD=OnCv0{_cxAdf=~8Kvc^_?{9ilXy0Qd*j>$8|f=Bx7YKY)rj0K!=A>0ebV43<3+4P zCon&GC9#47e$yV~7Ekwb(#s_r$b_!Qv%RM#nFf{%oj*6w%= zUTzmt9_oUxxNy;*ACu-I@0-o(2Lt_lo}5-Pvva9-YTZH>;N3Xa(4|hi;7C=*>v$Xk zQXVgO^bPgNLi&_RGjdU&&M`l_f44JtZYY=A%29xmPb82(ItjQZPPJnu(hk8&;oS2RV^ z)Lu@(HxuEr^Abkh0tdG?5BiM4=xSE(;HrdSPuG&!x}xOpkN|QhDs#u{Y7UZwO!NNI zrhepBms7;khqzh<(r)tUb zhYq7(-Tq)pf4T=Tec+YW3GmjIFI_ehM?HwNq|dsdct69)G_O=K5289oM6z-OeNSs> zs-_K?1C#BR2)cy6uw}w^PvAej4w&b96Xzo)R+ z7{qn15{{glz202^_L9x`9ukFJQATf=48D=5q}zsB zUvb}?u?qaG$=tu>C>KctE9odMmm~>VVpUZG>b7}{=-zr;zlj!*N*NfY@uN+#F@;HMj9{NB1vqN1r zr2wS>rNDn)0Up+O!U*-d{k2vrY7?2nK((D5XA1nODzOjwSI|$Ke}TAu4}CKoSO0q0 z0e|FGrGo{Y^Mq~ljb=PY4e#C`Zv}5T*{3`$eFc6hifLfS@rF8=@sc;FKkuqAKU_vhY6aS$dQ3Lt=K$tdN0 z-6~2};2`Ufvzs}A124Oza$Q3{{sKC$^Lg;pf;MRh_)yzx29s+xV6V?b z1}TZ_IkrPkE~=JETzA;jkP?La$?hK-so>F>(`sIEdEi~ifYl3x(C5#7!%g3jB<41? z=`hjH9Ti^6^HUXlWh)*GS;NmN>&s@uaGtw(`qV04M zhz5673Y-wpG=pCJgYWv?kZ&?`p3UTa4zHo*JMnRcGvh`L^;Yk`zv zJ#sG1`NwO(w`@-%r>@}s_|N|bp)Qb8fKq@`fKq@`;2$W!a&CUO=qqx38Vj?e@f?O5A9Bx$`qfW{kaOlK^qLwLeRdA>^mmH3Q3il=z@$WZVWQC)_XXBNpRBQ^d7rNU!ijj$W zUBuP)z|$ll(I0GbXD>;NhKpv}!5_-p@48?U9jqX?f4axcVPCQHGId4FD27la-KTFypr>)Voq(L3lL@6cX# zJ{Eq}Ke#2Rmrx2&3Q!7A3Q!7A3j9k2+HBbO*jb_9=#_W*XH(4U+Il2cgq7u zRjbvGf@8$p?yi{ilai%m33u?)sBmVD{TI~D_8!&QHj2J)K3}=QR+3m(_(+7U68TJ1 z@wei@MaLO3N-t87d)XCw^Hdl~>}mW_-VF}nof%^s^}?Rn1ciY~Pt>{S$zvi8B%vrJ z;8zUJ*(f$P&9#&y4vD?C3LAuP$0PqI3BOF>{_0Ex=vn;ZrFO z-^+J~A7?tMbx;ZCt>XNb<9z7T@53wn6ZO1@P1(d^oX4igr5xbSpKFY`UttcAyL2F+ z!2@}u;=KID(C_`){XIT-AD^r1PsT%^fBAJ%FQ*is6rdEK6rdEK6!--c@GLhoc@{(x zwy^~?Mg;sBvud`SIQTbNx~GbBNP^yUUW4Zvd?bsZz7p_|O$ipkGeM{C$?b!Yf1LRWANIN>^4>=xU1aOM{jgD_M6H6 z2xgr^-}C#O8E5Zf{>^P3U(E=79qmXV(?OCrpe?6m)rPsbVEHB$@Y7)XQQ?Krv$;-D zom${IGul^PUPJ8ld-tu!Pk|)11!WR6^a;78d_TttKGJ-!Y)B6NTd~(WtvMpd1+{#? zfyO{x@>1!&<+zS1P3Ps$B1yt(qo=&K1xZv0o{UVEB8fL8_hWnc;R`K2w1SD(IXdk2 zDn0Hpw>0Hwe$ra&ce$$k>` zrBRxYa1QuGqodx29*Ep_#*9!E>R|fpeDBQRH&yxPf&x?x|8OQGa<gGYm!siR+1tQjt2C>Zf~&r= zD!MS+Czf-W~vpR**ZWZp}lkBRR@g8v%yUA0f2^33;d+r2wVCZ?1qf?e7{d zZsb%ZP8mnC!B@(<{eA>})z4k|-_kK}78^|u&jvRYl={V8orii|RGdgZ_(hrjv-Cmu zJL$0;TJ}!JL&(k0QV&JHxOfDsDH-*_++fYbT;vggObIft_)x53d5C9HcI)i7);mYz9MqE69ckY4gA4Qo@aSWcUdgH z%ctjg-|6mopZjn!7*A8i-Z&~xhqFL6P1RmDlx3>9AM65m} zF4ygvRk6&o`Sr`BjrYrfIWP|vz#>=z6=(@op>41w*n#eSU?2WSa0)Hyz$a(W`7kWUt@T~JSiX8|MUGJe*GPi{x|N$<$<}8d7_TXBj+;D)XY7}yCCKLP>+y1 jl6Uy&PCM9__szSnVlMlEy-~uPy~3Vh@34p1OYEs9-}75a literal 0 HcmV?d00001 diff --git a/tests/test_ectrans4py/test_ectrans4py.py b/tests/test_ectrans4py/test_ectrans4py.py index 0a17f550a..f96c3f7dc 100644 --- a/tests/test_ectrans4py/test_ectrans4py.py +++ b/tests/test_ectrans4py/test_ectrans4py.py @@ -6,9 +6,20 @@ ectrans4py.init_env() KNUMMAXRESOL = 10 +EPSILON = 1e-13 -class TestLAM(TestCase): +class ArraysAlmostEqual(object): + + def assert_arrays_diff_under_epsilon(self, x, y): + diff = x - y + diffmax = abs(diff.max()) + diffmin = abs(diff.min()) + self.assertTrue(diffmax < EPSILON, "diffmax is {}".format(diffmax)) + self.assertTrue(diffmin < EPSILON, "diffmin is {}".format(diffmin)) + + +class TestLAM(TestCase, ArraysAlmostEqual): gpdims = {'X':54, 'Y':48, @@ -18,10 +29,12 @@ class TestLAM(TestCase): 'Y_resolution':1300.0} truncation = {'in_X':26, 'in_Y':23} - spectra_data_sizes = (2592, 1968) + spectral_data_sizes = (2592, 1968) + spdata = data.antwrp1300['sp'] + gpdata = data.antwrp1300['sp2gp'] def test_etrans_inq(self): - spectra_data_sizes = ectrans4py.etrans_inq4py( + spectral_data_sizes = ectrans4py.etrans_inq4py( self.gpdims['X'], self.gpdims['Y'], self.gpdims['X_CIzone'], @@ -31,10 +44,42 @@ def test_etrans_inq(self): KNUMMAXRESOL, self.gpdims['X_resolution'], self.gpdims['Y_resolution']) - self.assertEqual(spectra_data_sizes, self.spectra_data_sizes) + self.assertEqual(spectral_data_sizes, self.spectral_data_sizes) + def test_sp2gp(self): + gpdata = ectrans4py.sp2gp_lam4py( + self.gpdims['X'], + self.gpdims['Y'], + self.gpdims['X_CIzone'], + self.gpdims['Y_CIzone'], + self.truncation['in_X'], + self.truncation['in_Y'], + KNUMMAXRESOL, + len(self.spdata.flatten()), + False, # no derivatives + False, # spectral_coeff_order != 'model', + self.gpdims['X_resolution'], + self.gpdims['Y_resolution'], + self.spdata.flatten())[0] + self.assert_arrays_diff_under_epsilon(gpdata, gpdata.flatten()) + + def test_gp2sp(self): + spdata = ectrans4py.gp2sp_lam4py( + self.spectral_data_sizes[1], + self.gpdims['X'], + self.gpdims['Y'], + self.gpdims['X_CIzone'], + self.gpdims['Y_CIzone'], + self.truncation['in_X'], + self.truncation['in_Y'], + KNUMMAXRESOL, + self.gpdims['X_resolution'], + self.gpdims['Y_resolution'], + False, # spectral_coeff_order != 'model', + self.gpdata.flatten()) + self.assert_arrays_diff_under_epsilon(spdata, spdata.flatten()) -class TestGlobal(TestCase): +class TestGlobal(TestCase, ArraysAlmostEqual): gpdims = {'lat_number':150, 'lon_number_by_lat':data.lon_number_by_lat} @@ -43,13 +88,43 @@ class TestGlobal(TestCase): 33052, 11175, data.zonal_wavenumbers) + spdata = data.tl149_c24['sp'] + gpdata = data.tl149_c24['sp2gp'] def test_trans_inq4py(self): spectral_data_sizes = ectrans4py.trans_inq4py( self.gpdims['lat_number'], self.truncation['max'], len(self.gpdims['lon_number_by_lat']), - numpy.array(self.gpdims['lon_number_by_lat']), + self.gpdims['lon_number_by_lat'], KNUMMAXRESOL) self.assertEqual(spectral_data_sizes[0:2], self.spectral_data_sizes[0:2]) # dimensions numpy.testing.assert_array_equal(spectral_data_sizes[2], self.spectral_data_sizes[2]) # zonal_wavenumbers + + def test_sp2gp(self): + gpdata = ectrans4py.sp2gp_gauss4py( + self.gpdims['lat_number'], + self.truncation['max'], + KNUMMAXRESOL, + sum(self.gpdims['lon_number_by_lat']), + len(self.gpdims['lon_number_by_lat']), + self.gpdims['lon_number_by_lat'], + len(self.spdata.flatten()), + False, # no derivatives + False, # spectral_coeff_order != 'model', + self.spdata.flatten())[0] + self.assert_arrays_diff_under_epsilon(gpdata, gpdata.flatten()) + + def test_gp2sp(self): + spdata = ectrans4py.gp2sp_gauss4py( + self.spectral_data_sizes[1] * 2, # *2 for complex coefficients + self.gpdims['lat_number'], + self.truncation['max'], + KNUMMAXRESOL, + len(self.gpdims['lon_number_by_lat']), + self.gpdims['lon_number_by_lat'], + len(self.gpdata.flatten()), + False, # spectral_coeff_order != 'model', + self.gpdata.flatten()) + self.assert_arrays_diff_under_epsilon(spdata, spdata.flatten()) + From fbbe3ed825aab860ef0e2e3cfab3e32e4bce2059 Mon Sep 17 00:00:00 2001 From: Alexandre MARY Date: Thu, 23 Jan 2025 17:26:37 +0100 Subject: [PATCH 24/25] add info about ectrans4py in README --- README.md | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/README.md b/README.md index 82cf05f87..be959cbb9 100644 --- a/README.md +++ b/README.md @@ -106,6 +106,28 @@ The benchmark drivers are found in the bin directory. A brief description of available command-line arguments can be obtained with e.g. ectrans-benchmark-cpu-sp --help +Building `ectrans4py` +--------------------- + +The python wheel can be built from the root of the project, assuming above-mentioned variables are defined (`fiat_ROOT` etc...): +``` +python -m build --wheel +``` +and then: +``` +python -m auditwheel +``` +The built python wheel is then to be found in directory `wheelhouse/` and can be locally installed by pip: +``` +pip install wheelhouse/ectrans4py-(...).whl +``` +The `_skbuild` and `dist` directories can be deleted. + +Tests can be run from `tests/test_ectrans4py/`: +``` +python -m pytest +``` + Reporting Bugs ============== From 2cdfb1e4e22ef331130483653a1b7be4a2ddfcf2 Mon Sep 17 00:00:00 2001 From: Alexandre MARY Date: Mon, 27 Jan 2025 14:12:44 +0100 Subject: [PATCH 25/25] adapt compilectrans4py build: fftw and omp --- setup.py | 3 ++- src/ectrans4py/__init__.py | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/setup.py b/setup.py index 3fc19a53e..fba45df80 100644 --- a/setup.py +++ b/setup.py @@ -16,7 +16,8 @@ '-DENABLE_ECTRANS4PY=ON', '-DENABLE_SINGLE_PRECISION=OFF', '-DENABLE_PROGRAMS=OFF', - '-DENABLE_OMP=OFF', + '-DENABLE_OMP=ON', + '-DFFTW_USE_STATIC_LIBS=ON', ], package_dir={"": "src"}, cmake_install_dir="src/ectrans4py", diff --git a/src/ectrans4py/__init__.py b/src/ectrans4py/__init__.py index 224c30c45..dd7b365eb 100644 --- a/src/ectrans4py/__init__.py +++ b/src/ectrans4py/__init__.py @@ -15,7 +15,7 @@ from ctypesForFortran import addReturnCode, treatReturnCode, IN, OUT -__version__ = "1.2.51" +__version__ = "1.5.1" # Shared objects library