! $Header$ SUBROUTINE ADVYP(LIMIT, DTY, PBARV, SM, S0, SSX, SY, SZ & , SSXX, SSXY, SSXZ, SYY, SYZ, SZZ, ntra) USE lmdz_comgeom IMPLICIT NONE !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC ! C ! second-order moments (SOM) advection of tracer in Y direction C ! C !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC ! C ! Source : Pascal Simon ( Meteo, CNRM ) C ! Adaptation : A.A. (LGGE) C ! Derniere Modif : 19/10/95 LAST ! C ! sont les arguments d'entree pour le s-pg C ! C ! argument de sortie du s-pg C ! C !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC ! ! Rem : Probleme aux poles il faut reecrire ce cas specifique ! Attention au sens de l'indexation ! ! parametres principaux du modele ! ! INCLUDE "dimensions.h" INCLUDE "paramet.h" ! Arguments : ! ---------- ! dty : frequence fictive d'appel du transport ! parbu,pbarv : flux de masse en x et y en Pa.m2.s-1 INTEGER :: lon, lat, niv INTEGER :: i, j, jv, k, kp, l INTEGER :: ntra ! PARAMETER (ntra = 1) REAL :: dty REAL :: pbarv (iip1, jjm, llm) ! moments: SM total mass in each grid box ! S0 mass of tracer in each grid box ! Si 1rst order moment in i direction ! REAL :: SM(iip1, jjp1, llm) & , S0(iip1, jjp1, llm, ntra) REAL :: SSX(iip1, jjp1, llm, ntra) & , SY(iip1, jjp1, llm, ntra) & , SZ(iip1, jjp1, llm, ntra) & , SSXX(iip1, jjp1, llm, ntra) & , SSXY(iip1, jjp1, llm, ntra) & , SSXZ(iip1, jjp1, llm, ntra) & , SYY(iip1, jjp1, llm, ntra) & , SYZ(iip1, jjp1, llm, ntra) & , SZZ(iip1, jjp1, llm, ntra) ! ! Local : ! ------- ! mass fluxes across the boundaries (UGRI,VGRI,WGRI) ! mass fluxes in kg ! declaration : REAL :: VGRI(iip1, 0:jjp1, llm) ! Rem : UGRI et WGRI ne sont pas utilises dans ! cette SUBROUTINE ( advection en y uniquement ) ! Rem 2 :le dimensionnement de VGRI depend de celui de pbarv ! ! the moments F are similarly defined and used as temporary ! storage for portions of the grid boxes in transit ! ! the moments Fij are used as temporary storage for ! portions of the grid boxes in transit at the current level ! ! work arrays ! ! REAL :: F0(iim, 0:jjp1, ntra), FM(iim, 0:jjp1) REAL :: FX(iim, jjm, ntra), FY(iim, jjm, ntra) REAL :: FZ(iim, jjm, ntra) REAL :: FXX(iim, jjm, ntra), FXY(iim, jjm, ntra) REAL :: FXZ(iim, jjm, ntra), FYY(iim, jjm, ntra) REAL :: FYZ(iim, jjm, ntra), FZZ(iim, jjm, ntra) REAL :: S00(ntra) REAL :: SM0 ! Just temporal variable ! ! work arrays ! REAL :: ALF(iim, 0:jjp1), ALF1(iim, 0:jjp1) REAL :: ALFQ(iim, 0:jjp1), ALF1Q(iim, 0:jjp1) REAL :: ALF2(iim, 0:jjp1), ALF3(iim, 0:jjp1) REAL :: ALF4(iim, 0:jjp1) REAL :: TEMPTM ! Just temporal variable REAL :: SLPMAX, S1MAX, S1NEW, S2NEW ! ! Special pour poles ! REAL :: sbms, sfms, sfzs, sbmn, sfmn, sfzn REAL :: sns0(ntra), snsz(ntra), snsm REAL :: qy1(iim, llm, ntra), qylat(iim, llm, ntra) REAL :: cx1(llm, ntra), cxLAT(llm, ntra) REAL :: cy1(llm, ntra), cyLAT(llm, ntra) REAL :: z1(iim), zcos(iim), zsin(iim) ! REAL :: sqi, sqf LOGICAL :: LIMIT lon = iim ! rem : Il est possible qu'un pbl. arrive ici lat = jjp1 ! a cause des dim. differentes entre les niv = llm ! tab. S et VGRI !----------------------------------------------------------------- ! initialisations sbms = 0. sfms = 0. sfzs = 0. sbmn = 0. sfmn = 0. sfzn = 0. !----------------------------------------------------------------- ! *** Test : diag de la qtite totale de traceur dans ! l'atmosphere avant l'advection en Y ! sqi = 0. sqf = 0. DO l = 1, llm DO j = 1, jjp1 DO i = 1, iim sqi = sqi + S0(i, j, l, ntra) END DO END DO END DO PRINT*, '---------- DIAG DANS ADVY - ENTREE --------' PRINT*, 'sqi=', sqi !----------------------------------------------------------------- ! Interface : adaptation nouveau modele ! ------------------------------------- ! ! Conversion des flux de masses en kg !-AA 20/10/94 le signe -1 est necessaire car indexation opposee DO l = 1, llm DO j = 1, jjm DO i = 1, iip1 vgri (i, j, llm + 1 - l) = -1. * pbarv (i, j, l) END DO END DO END DO !AA Initialisation de flux fictifs aux bords sup. des boites pol. DO l = 1, llm DO i = 1, iip1 vgri(i, 0, l) = 0. vgri(i, jjp1, l) = 0. ENDDO ENDDO ! !----------------- START HERE ----------------------- ! boucle sur les niveaux ! DO L = 1, NIV ! ! place limits on appropriate moments before transport ! (if flux-limiting is to be applied) ! IF(.NOT.LIMIT) GO TO 11 ! DO JV = 1, NTRA DO K = 1, LAT DO I = 1, LON IF(S0(I, K, L, JV)>0.) THEN SLPMAX = AMAX1(S0(I, K, L, JV), 0.) S1MAX = 1.5 * SLPMAX S1NEW = AMIN1(S1MAX, AMAX1(-S1MAX, SY(I, K, L, JV))) S2NEW = AMIN1(2. * SLPMAX - ABS(S1NEW) / 3., & AMAX1(ABS(S1NEW) - SLPMAX, SYY(I, K, L, JV))) SY (I, K, L, JV) = S1NEW SYY(I, K, L, JV) = S2NEW SSXY(I, K, L, JV) = AMIN1(SLPMAX, AMAX1(-SLPMAX, SSXY(I, K, L, JV))) SYZ(I, K, L, JV) = AMIN1(SLPMAX, AMAX1(-SLPMAX, SYZ(I, K, L, JV))) ELSE SY (I, K, L, JV) = 0. SYY(I, K, L, JV) = 0. SSXY(I, K, L, JV) = 0. SYZ(I, K, L, JV) = 0. ENDIF END DO END DO END DO ! 11 CONTINUE ! ! le flux a travers le pole Nord est traite separement ! SM0 = 0. DO JV = 1, NTRA S00(JV) = 0. END DO ! DO I = 1, LON ! IF(VGRI(I, 0, L)<=0.) THEN FM(I, 0) = -VGRI(I, 0, L) * DTY ALF(I, 0) = FM(I, 0) / SM(I, 1, L) SM(I, 1, L) = SM(I, 1, L) - FM(I, 0) SM0 = SM0 + FM(I, 0) ENDIF ! ALFQ(I, 0) = ALF(I, 0) * ALF(I, 0) ALF1(I, 0) = 1. - ALF(I, 0) ALF1Q(I, 0) = ALF1(I, 0) * ALF1(I, 0) ALF2(I, 0) = ALF1(I, 0) - ALF(I, 0) ALF3(I, 0) = ALF(I, 0) * ALFQ(I, 0) ALF4(I, 0) = ALF1(I, 0) * ALF1Q(I, 0) ! END DO ! PRINT*,'ADVYP 21' ! DO JV = 1, NTRA DO I = 1, LON ! IF(VGRI(I, 0, L)<=0.) THEN ! F0(I, 0, JV) = ALF(I, 0) * (S0(I, 1, L, JV) - ALF1(I, 0) * & (SY(I, 1, L, JV) - ALF2(I, 0) * SYY(I, 1, L, JV))) ! S00(JV) = S00(JV) + F0(I, 0, JV) S0 (I, 1, L, JV) = S0(I, 1, L, JV) - F0(I, 0, JV) SY (I, 1, L, JV) = ALF1Q(I, 0) * & (SY(I, 1, L, JV) + 3. * ALF(I, 0) * SYY(I, 1, L, JV)) SYY(I, 1, L, JV) = ALF4 (I, 0) * SYY(I, 1, L, JV) SSX (I, 1, L, JV) = ALF1 (I, 0) * & (SSX(I, 1, L, JV) + ALF(I, 0) * SSXY(I, 1, L, JV)) SZ (I, 1, L, JV) = ALF1 (I, 0) * & (SZ(I, 1, L, JV) + ALF(I, 0) * SSXZ(I, 1, L, JV)) SSXX(I, 1, L, JV) = ALF1 (I, 0) * SSXX(I, 1, L, JV) SSXZ(I, 1, L, JV) = ALF1 (I, 0) * SSXZ(I, 1, L, JV) SZZ(I, 1, L, JV) = ALF1 (I, 0) * SZZ(I, 1, L, JV) SSXY(I, 1, L, JV) = ALF1Q(I, 0) * SSXY(I, 1, L, JV) SYZ(I, 1, L, JV) = ALF1Q(I, 0) * SYZ(I, 1, L, JV) ! ENDIF ! END DO END DO ! DO I = 1, LON IF(VGRI(I, 0, L)>0.) THEN FM(I, 0) = VGRI(I, 0, L) * DTY ALF(I, 0) = FM(I, 0) / SM0 ENDIF END DO ! DO JV = 1, NTRA DO I = 1, LON IF(VGRI(I, 0, L)>0.) THEN F0(I, 0, JV) = ALF(I, 0) * S00(JV) ENDIF END DO END DO ! ! puts the temporary moments Fi into appropriate neighboring boxes ! ! PRINT*,'av ADVYP 25' DO I = 1, LON ! IF(VGRI(I, 0, L)>0.) THEN SM(I, 1, L) = SM(I, 1, L) + FM(I, 0) ALF(I, 0) = FM(I, 0) / SM(I, 1, L) ENDIF ! ALFQ(I, 0) = ALF(I, 0) * ALF(I, 0) ALF1(I, 0) = 1. - ALF(I, 0) ALF1Q(I, 0) = ALF1(I, 0) * ALF1(I, 0) ALF2(I, 0) = ALF1(I, 0) - ALF(I, 0) ALF3(I, 0) = ALF1(I, 0) * ALF(I, 0) ! END DO ! PRINT*,'av ADVYP 25' ! DO JV = 1, NTRA DO I = 1, LON ! IF(VGRI(I, 0, L)>0.) THEN ! TEMPTM = ALF(I, 0) * S0(I, 1, L, JV) - ALF1(I, 0) * F0(I, 0, JV) S0 (I, 1, L, JV) = S0(I, 1, L, JV) + F0(I, 0, JV) SYY(I, 1, L, JV) = ALF1Q(I, 0) * SYY(I, 1, L, JV) & + 5. * (ALF3 (I, 0) * SY (I, 1, L, JV) - ALF2(I, 0) * TEMPTM) SY (I, 1, L, JV) = ALF1 (I, 0) * SY (I, 1, L, JV) + 3. * TEMPTM SSXY(I, 1, L, JV) = ALF1 (I, 0) * SSXY(I, 1, L, JV) + 3. * ALF(I, 0) * SSX(I, 1, L, JV) SYZ(I, 1, L, JV) = ALF1 (I, 0) * SYZ(I, 1, L, JV) + 3. * ALF(I, 0) * SZ(I, 1, L, JV) ! ENDIF ! END DO END DO ! ! calculate flux and moments between adjacent boxes ! 1- create temporary moments/masses for partial boxes in transit ! 2- reajusts moments remaining in the box ! ! flux from KP to K if V(K).lt.0 and from K to KP if V(K).gt.0 ! ! PRINT*,'av ADVYP 30' DO K = 1, LAT - 1 KP = K + 1 DO I = 1, LON ! IF(VGRI(I, K, L)<0.) THEN FM(I, K) = -VGRI(I, K, L) * DTY ALF(I, K) = FM(I, K) / SM(I, KP, L) SM(I, KP, L) = SM(I, KP, L) - FM(I, K) ELSE FM(I, K) = VGRI(I, K, L) * DTY ALF(I, K) = FM(I, K) / SM(I, K, L) SM(I, K, L) = SM(I, K, L) - FM(I, K) ENDIF ! ALFQ(I, K) = ALF(I, K) * ALF(I, K) ALF1(I, K) = 1. - ALF(I, K) ALF1Q(I, K) = ALF1(I, K) * ALF1(I, K) ALF2(I, K) = ALF1(I, K) - ALF(I, K) ALF3(I, K) = ALF(I, K) * ALFQ(I, K) ALF4(I, K) = ALF1(I, K) * ALF1Q(I, K) ! END DO END DO ! PRINT*,'ap ADVYP 30' ! DO JV = 1, NTRA DO K = 1, LAT - 1 KP = K + 1 DO I = 1, LON ! IF(VGRI(I, K, L)<0.) THEN ! F0 (I, K, JV) = ALF (I, K) * (S0(I, KP, L, JV) - ALF1(I, K) * & (SY(I, KP, L, JV) - ALF2(I, K) * SYY(I, KP, L, JV))) FY (I, K, JV) = ALFQ(I, K) * & (SY(I, KP, L, JV) - 3. * ALF1(I, K) * SYY(I, KP, L, JV)) FYY(I, K, JV) = ALF3(I, K) * SYY(I, KP, L, JV) FX (I, K, JV) = ALF (I, K) * & (SSX(I, KP, L, JV) - ALF1(I, K) * SSXY(I, KP, L, JV)) FZ (I, K, JV) = ALF (I, K) * & (SZ(I, KP, L, JV) - ALF1(I, K) * SYZ(I, KP, L, JV)) FXY(I, K, JV) = ALFQ(I, K) * SSXY(I, KP, L, JV) FYZ(I, K, JV) = ALFQ(I, K) * SYZ(I, KP, L, JV) FXX(I, K, JV) = ALF (I, K) * SSXX(I, KP, L, JV) FXZ(I, K, JV) = ALF (I, K) * SSXZ(I, KP, L, JV) FZZ(I, K, JV) = ALF (I, K) * SZZ(I, KP, L, JV) ! S0 (I, KP, L, JV) = S0(I, KP, L, JV) - F0(I, K, JV) SY (I, KP, L, JV) = ALF1Q(I, K) * & (SY(I, KP, L, JV) + 3. * ALF(I, K) * SYY(I, KP, L, JV)) SYY(I, KP, L, JV) = ALF4(I, K) * SYY(I, KP, L, JV) SSX (I, KP, L, JV) = SSX (I, KP, L, JV) - FX (I, K, JV) SZ (I, KP, L, JV) = SZ (I, KP, L, JV) - FZ (I, K, JV) SSXX(I, KP, L, JV) = SSXX(I, KP, L, JV) - FXX(I, K, JV) SSXZ(I, KP, L, JV) = SSXZ(I, KP, L, JV) - FXZ(I, K, JV) SZZ(I, KP, L, JV) = SZZ(I, KP, L, JV) - FZZ(I, K, JV) SSXY(I, KP, L, JV) = ALF1Q(I, K) * SSXY(I, KP, L, JV) SYZ(I, KP, L, JV) = ALF1Q(I, K) * SYZ(I, KP, L, JV) ! ELSE ! F0 (I, K, JV) = ALF (I, K) * (S0(I, K, L, JV) + ALF1(I, K) * & (SY(I, K, L, JV) + ALF2(I, K) * SYY(I, K, L, JV))) FY (I, K, JV) = ALFQ(I, K) * & (SY(I, K, L, JV) + 3. * ALF1(I, K) * SYY(I, K, L, JV)) FYY(I, K, JV) = ALF3(I, K) * SYY(I, K, L, JV) FX (I, K, JV) = ALF (I, K) * (SSX(I, K, L, JV) + ALF1(I, K) * SSXY(I, K, L, JV)) FZ (I, K, JV) = ALF (I, K) * (SZ(I, K, L, JV) + ALF1(I, K) * SYZ(I, K, L, JV)) FXY(I, K, JV) = ALFQ(I, K) * SSXY(I, K, L, JV) FYZ(I, K, JV) = ALFQ(I, K) * SYZ(I, K, L, JV) FXX(I, K, JV) = ALF (I, K) * SSXX(I, K, L, JV) FXZ(I, K, JV) = ALF (I, K) * SSXZ(I, K, L, JV) FZZ(I, K, JV) = ALF (I, K) * SZZ(I, K, L, JV) ! S0 (I, K, L, JV) = S0 (I, K, L, JV) - F0 (I, K, JV) SY (I, K, L, JV) = ALF1Q(I, K) * & (SY(I, K, L, JV) - 3. * ALF(I, K) * SYY(I, K, L, JV)) SYY(I, K, L, JV) = ALF4(I, K) * SYY(I, K, L, JV) SSX (I, K, L, JV) = SSX (I, K, L, JV) - FX (I, K, JV) SZ (I, K, L, JV) = SZ (I, K, L, JV) - FZ (I, K, JV) SSXX(I, K, L, JV) = SSXX(I, K, L, JV) - FXX(I, K, JV) SSXZ(I, K, L, JV) = SSXZ(I, K, L, JV) - FXZ(I, K, JV) SZZ(I, K, L, JV) = SZZ(I, K, L, JV) - FZZ(I, K, JV) SSXY(I, K, L, JV) = ALF1Q(I, K) * SSXY(I, K, L, JV) SYZ(I, K, L, JV) = ALF1Q(I, K) * SYZ(I, K, L, JV) ! ENDIF ! END DO END DO END DO ! PRINT*,'ap ADVYP 31' ! ! puts the temporary moments Fi into appropriate neighboring boxes ! DO K = 1, LAT - 1 KP = K + 1 DO I = 1, LON ! IF(VGRI(I, K, L)<0.) THEN SM(I, K, L) = SM(I, K, L) + FM(I, K) ALF(I, K) = FM(I, K) / SM(I, K, L) ELSE SM(I, KP, L) = SM(I, KP, L) + FM(I, K) ALF(I, K) = FM(I, K) / SM(I, KP, L) ENDIF ! ALFQ(I, K) = ALF(I, K) * ALF(I, K) ALF1(I, K) = 1. - ALF(I, K) ALF1Q(I, K) = ALF1(I, K) * ALF1(I, K) ALF2(I, K) = ALF1(I, K) - ALF(I, K) ALF3(I, K) = ALF1(I, K) * ALF(I, K) ! END DO END DO ! PRINT*,'ap ADVYP 32' ! DO JV = 1, NTRA DO K = 1, LAT - 1 KP = K + 1 DO I = 1, LON ! IF(VGRI(I, K, L)<0.) THEN ! TEMPTM = -ALF(I, K) * S0(I, K, L, JV) + ALF1(I, K) * F0(I, K, JV) S0 (I, K, L, JV) = S0(I, K, L, JV) + F0(I, K, JV) SYY(I, K, L, JV) = ALFQ(I, K) * FYY(I, K, JV) + ALF1Q(I, K) * SYY(I, K, L, JV) & + 5. * (ALF3(I, K) * (FY(I, K, JV) - SY(I, K, L, JV)) + ALF2(I, K) * TEMPTM) SY (I, K, L, JV) = ALF(I, K) * FY(I, K, JV) + ALF1(I, K) * SY(I, K, L, JV) & + 3. * TEMPTM SSXY(I, K, L, JV) = ALF (I, K) * FXY(I, K, JV) + ALF1(I, K) * SSXY(I, K, L, JV) & + 3. * (ALF1(I, K) * FX (I, K, JV) - ALF (I, K) * SSX (I, K, L, JV)) SYZ(I, K, L, JV) = ALF (I, K) * FYZ(I, K, JV) + ALF1(I, K) * SYZ(I, K, L, JV) & + 3. * (ALF1(I, K) * FZ (I, K, JV) - ALF (I, K) * SZ (I, K, L, JV)) SSX (I, K, L, JV) = SSX (I, K, L, JV) + FX (I, K, JV) SZ (I, K, L, JV) = SZ (I, K, L, JV) + FZ (I, K, JV) SSXX(I, K, L, JV) = SSXX(I, K, L, JV) + FXX(I, K, JV) SSXZ(I, K, L, JV) = SSXZ(I, K, L, JV) + FXZ(I, K, JV) SZZ(I, K, L, JV) = SZZ(I, K, L, JV) + FZZ(I, K, JV) ! ELSE ! TEMPTM = ALF(I, K) * S0(I, KP, L, JV) - ALF1(I, K) * F0(I, K, JV) S0 (I, KP, L, JV) = S0(I, KP, L, JV) + F0(I, K, JV) SYY(I, KP, L, JV) = ALFQ(I, K) * FYY(I, K, JV) + ALF1Q(I, K) * SYY(I, KP, L, JV) & + 5. * (ALF3(I, K) * (SY(I, KP, L, JV) - FY(I, K, JV)) - ALF2(I, K) * TEMPTM) SY (I, KP, L, JV) = ALF(I, K) * FY(I, K, JV) + ALF1(I, K) * SY(I, KP, L, JV) & + 3. * TEMPTM SSXY(I, KP, L, JV) = ALF(I, K) * FXY(I, K, JV) + ALF1(I, K) * SSXY(I, KP, L, JV) & + 3. * (ALF(I, K) * SSX(I, KP, L, JV) - ALF1(I, K) * FX(I, K, JV)) SYZ(I, KP, L, JV) = ALF(I, K) * FYZ(I, K, JV) + ALF1(I, K) * SYZ(I, KP, L, JV) & + 3. * (ALF(I, K) * SZ(I, KP, L, JV) - ALF1(I, K) * FZ(I, K, JV)) SSX (I, KP, L, JV) = SSX (I, KP, L, JV) + FX (I, K, JV) SZ (I, KP, L, JV) = SZ (I, KP, L, JV) + FZ (I, K, JV) SSXX(I, KP, L, JV) = SSXX(I, KP, L, JV) + FXX(I, K, JV) SSXZ(I, KP, L, JV) = SSXZ(I, KP, L, JV) + FXZ(I, K, JV) SZZ(I, KP, L, JV) = SZZ(I, KP, L, JV) + FZZ(I, K, JV) ! ENDIF ! END DO END DO END DO ! PRINT*,'ap ADVYP 33' ! ! traitement special pour le pole Sud (idem pole Nord) ! K = LAT ! SM0 = 0. DO JV = 1, NTRA S00(JV) = 0. END DO ! DO I = 1, LON ! IF(VGRI(I, K, L)>=0.) THEN FM(I, K) = VGRI(I, K, L) * DTY ALF(I, K) = FM(I, K) / SM(I, K, L) SM(I, K, L) = SM(I, K, L) - FM(I, K) SM0 = SM0 + FM(I, K) ENDIF ! ALFQ(I, K) = ALF(I, K) * ALF(I, K) ALF1(I, K) = 1. - ALF(I, K) ALF1Q(I, K) = ALF1(I, K) * ALF1(I, K) ALF2(I, K) = ALF1(I, K) - ALF(I, K) ALF3(I, K) = ALF(I, K) * ALFQ(I, K) ALF4(I, K) = ALF1(I, K) * ALF1Q(I, K) ! END DO ! PRINT*,'ap ADVYP 41' ! DO JV = 1, NTRA DO I = 1, LON ! IF(VGRI(I, K, L)>=0.) THEN F0 (I, K, JV) = ALF(I, K) * (S0(I, K, L, JV) + ALF1(I, K) * & (SY(I, K, L, JV) + ALF2(I, K) * SYY(I, K, L, JV))) S00(JV) = S00(JV) + F0(I, K, JV) ! S0 (I, K, L, JV) = S0 (I, K, L, JV) - F0 (I, K, JV) SY (I, K, L, JV) = ALF1Q(I, K) * & (SY(I, K, L, JV) - 3. * ALF(I, K) * SYY(I, K, L, JV)) SYY(I, K, L, JV) = ALF4 (I, K) * SYY(I, K, L, JV) SSX (I, K, L, JV) = ALF1(I, K) * (SSX(I, K, L, JV) - ALF(I, K) * SSXY(I, K, L, JV)) SZ (I, K, L, JV) = ALF1(I, K) * (SZ(I, K, L, JV) - ALF(I, K) * SYZ(I, K, L, JV)) SSXX(I, K, L, JV) = ALF1 (I, K) * SSXX(I, K, L, JV) SSXZ(I, K, L, JV) = ALF1 (I, K) * SSXZ(I, K, L, JV) SZZ(I, K, L, JV) = ALF1 (I, K) * SZZ(I, K, L, JV) SSXY(I, K, L, JV) = ALF1Q(I, K) * SSXY(I, K, L, JV) SYZ(I, K, L, JV) = ALF1Q(I, K) * SYZ(I, K, L, JV) ENDIF ! END DO END DO ! PRINT*,'ap ADVYP 42' ! DO I = 1, LON IF(VGRI(I, K, L)<0.) THEN FM(I, K) = -VGRI(I, K, L) * DTY ALF(I, K) = FM(I, K) / SM0 ENDIF END DO ! PRINT*,'ap ADVYP 43' ! DO JV = 1, NTRA DO I = 1, LON IF(VGRI(I, K, L)<0.) THEN F0(I, K, JV) = ALF(I, K) * S00(JV) ENDIF END DO END DO ! ! puts the temporary moments Fi into appropriate neighboring boxes ! DO I = 1, LON ! IF(VGRI(I, K, L)<0.) THEN SM(I, K, L) = SM(I, K, L) + FM(I, K) ALF(I, K) = FM(I, K) / SM(I, K, L) ENDIF ! ALFQ(I, K) = ALF(I, K) * ALF(I, K) ALF1(I, K) = 1. - ALF(I, K) ALF1Q(I, K) = ALF1(I, K) * ALF1(I, K) ALF2(I, K) = ALF1(I, K) - ALF(I, K) ALF3(I, K) = ALF1(I, K) * ALF(I, K) ! END DO ! PRINT*,'ap ADVYP 45' ! DO JV = 1, NTRA DO I = 1, LON ! IF(VGRI(I, K, L)<0.) THEN ! TEMPTM = -ALF(I, K) * S0(I, K, L, JV) + ALF1(I, K) * F0(I, K, JV) S0 (I, K, L, JV) = S0(I, K, L, JV) + F0(I, K, JV) SYY(I, K, L, JV) = ALF1Q(I, K) * SYY(I, K, L, JV) & + 5. * (-ALF3 (I, K) * SY (I, K, L, JV) + ALF2(I, K) * TEMPTM) SY (I, K, L, JV) = ALF1(I, K) * SY (I, K, L, JV) + 3. * TEMPTM SSXY(I, K, L, JV) = ALF1(I, K) * SSXY(I, K, L, JV) - 3. * ALF(I, K) * SSX(I, K, L, JV) SYZ(I, K, L, JV) = ALF1(I, K) * SYZ(I, K, L, JV) - 3. * ALF(I, K) * SZ(I, K, L, JV) ! ENDIF ! END DO END DO ! PRINT*,'ap ADVYP 46' ! END DO !-------------------------------------------------- ! bouclage cyclique horizontal . DO l = 1, llm DO jv = 1, ntra DO j = 1, jjp1 SM(iip1, j, l) = SM(1, j, l) S0(iip1, j, l, jv) = S0(1, j, l, jv) SSX(iip1, j, l, jv) = SSX(1, j, l, jv) SY(iip1, j, l, jv) = SY(1, j, l, jv) SZ(iip1, j, l, jv) = SZ(1, j, l, jv) END DO END DO END DO ! ------------------------------------------------------------------- ! *** Test negativite: ! DO jv = 1,ntra ! DO l = 1,llm ! DO j = 1,jjp1 ! DO i = 1,iip1 ! IF (s0( i,j,l,jv ).lt.0.) THEN ! PRINT*, '------ S0 < 0 en FIN ADVYP ---' ! PRINT*, 'S0(',i,j,l,jv,')=', S0(i,j,l,jv) !c STOP ! ENDIF ! ENDDO ! ENDDO ! ENDDO ! ENDDO ! ------------------------------------------------------------------- ! *** Test : diag de la qtite totale de traceur dans ! l'atmosphere avant l'advection en Y DO l = 1, llm DO j = 1, jjp1 DO i = 1, iim sqf = sqf + S0(i, j, l, ntra) END DO END DO END DO PRINT*, '---------- DIAG DANS ADVY - SORTIE --------' PRINT*, 'sqf=', sqf ! PRINT*,'ap ADVYP fin' !----------------------------------------------------------------- ! RETURN END SUBROUTINE ADVYP