Ignore:
Timestamp:
Oct 21, 2024, 2:58:45 PM (23 hours ago)
Author:
abarral
Message:

Convert fixed-form to free-form sources .F -> .{f,F}90
(WIP: some .F remain, will be handled in subsequent commits)

File:
1 moved

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/dyn3d_common/advz.f90

    r5245 r5246  
    22! $Header$
    33!
    4       SUBROUTINE advz(limit,dtz,w,sm,s0,sx,sy,sz)
    5       IMPLICIT NONE
    6 
    7 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
    8 C                                                                C
    9 C  first-order moments (FOM) advection of tracer in Z direction  C
    10 C                                                                C
    11 C  Source : Pascal Simon (Meteo,CNRM)                            C
    12 C  Adaptation : A.Armengaud (LGGE) juin 94                       C
    13 C                                                                C
    14 C                                                                C
    15 C  sont des arguments d'entree pour le s-pg...                   C
    16 C                                                                C
    17 C  dq est l'argument de sortie pour le s-pg                      C
    18 C                                                                C
    19 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
    20 C
    21 C  parametres principaux du modele
    22 C
    23       include "dimensions.h"
    24       include "paramet.h"
    25 
    26 C     INCLUDE "traceur.h"
    27 
    28 C  Arguments :
    29 C  -----------
    30 C  dtz : frequence fictive d'appel du transport
    31 C  w : flux de masse en z en Pa.m2.s-1
    32 
    33       INTEGER ntra
    34       PARAMETER (ntra = 1)
    35 
    36       REAL dtz
    37       REAL w ( iip1,jjp1,llm )
    38    
    39 C  moments: SM  total mass in each grid box
    40 C           S0  mass of tracer in each grid box
    41 C           Si  1rst order moment in i direction
    42 C
    43       REAL SM(iip1,jjp1,llm)
    44      +    ,S0(iip1,jjp1,llm,ntra)
    45       REAL sx(iip1,jjp1,llm,ntra)
    46      +    ,sy(iip1,jjp1,llm,ntra)
    47      +    ,sz(iip1,jjp1,llm,ntra)
    48 
    49 
    50 C  Local :
    51 C  -------
    52 
    53 C  mass fluxes across the boundaries (UGRI,VGRI,WGRI)
    54 C  mass fluxes in kg
    55 C  declaration :
    56 
    57       REAL WGRI(iip1,jjp1,0:llm)
    58 
    59 C
    60 C  the moments F are used as temporary  storage for
    61 C  portions of grid boxes in transit at the current latitude
    62 C
    63       REAL FM(iim,llm)
    64       REAL F0(iim,llm,ntra),FX(iim,llm,ntra)
    65       REAL FY(iim,llm,ntra),FZ(iim,llm,ntra)
    66 C
    67 C  work arrays
    68 C
    69       REAL ALF(iim),ALF1(iim),ALFQ(iim),ALF1Q(iim)
    70       REAL TEMPTM            ! Just temporal variable
    71       REAL sqi,sqf
    72 C
    73       LOGICAL LIMIT
    74       INTEGER lon,lat,niv
    75       INTEGER i,j,jv,k,l,lp
    76 
    77       lon = iim
    78       lat = jjp1
    79       niv = llm
    80 
    81 C *** Test de passage d'arguments ******
    82  
    83 c     DO 399 l = 1, llm
    84 c     DO 399 j = 1, jjp1
    85 c     DO 399 i = 1, iip1
    86 c        IF (S0(i,j,l,ntra) .lt. 0. ) THEN
    87 c           PRINT*,'S0(',i,j,l,')=',S0(i,j,l,ntra)
    88 c           print*, 'sx(',i,j,l,')=',sx(i,j,l,ntra)
    89 c           print*, 'sy(',i,j,l,')=',sy(i,j,l,ntra)
    90 c           print*, 'sz(',i,j,l,')=',sz(i,j,l,ntra)
    91 c           PRINT*, 'AIE !! debut ADVZ - pbl arg. passage dans ADVZ'
    92 c            STOP
    93 c        ENDIF
    94   399 CONTINUE
    95 
    96 C-----------------------------------------------------------------
    97 C *** Test : diag de la qqtite totale de traceur
    98 C            dans l'atmosphere avant l'advection en z
    99       sqi = 0.
    100       sqf = 0.
    101 
    102       DO l = 1,llm
    103          DO j = 1,jjp1
    104             DO i = 1,iim
    105 cIM 240305            sqi = sqi + S0(i,j,l,9)
    106                sqi = sqi + S0(i,j,l,ntra)
    107             ENDDO
    108          ENDDO
    109       ENDDO
    110       PRINT*,'-------- DIAG DANS ADVZ - ENTREE ---------'
    111       PRINT*,'sqi=',sqi
    112 
    113 C-----------------------------------------------------------------
    114 C  Interface : adaptation nouveau modele
    115 C  -------------------------------------
    116 C
    117 C  Conversion du flux de masse en kg.s-1
    118 
    119       DO 500 l = 1,llm
    120          DO 500 j = 1,jjp1
    121             DO 500 i = 1,iip1 
    122 c            wgri (i,j,llm+1-l) =  w (i,j,l) / g
    123                wgri (i,j,llm+1-l) =  w (i,j,l)
    124 c             wgri (i,j,0) = 0.                ! a detruire ult.
    125 c             wgri (i,j,l) = 0.1               !    w (i,j,l)
    126 c             wgri (i,j,llm) = 0.              ! a detruire ult.
    127   500 CONTINUE
    128          DO  j = 1,jjp1
    129             DO i = 1,iip1 
    130                wgri(i,j,0)=0.
    131             enddo
    132          enddo
    133 
    134 C-----------------------------------------------------------------
    135  
    136 C  start here         
    137 C  boucle sur les latitudes
    138 C
    139       DO 1 K=1,LAT
    140 C
    141 C  place limits on appropriate moments before transport
    142 C      (if flux-limiting is to be applied)
    143 C
    144       IF(.NOT.LIMIT) GO TO 101
    145 C
    146       DO 10 JV=1,NTRA
    147       DO 10 L=1,NIV
    148          DO 100 I=1,LON
    149             sz(I,K,L,JV)=SIGN(AMIN1(AMAX1(S0(I,K,L,JV),0.),
    150      +                              ABS(sz(I,K,L,JV))),sz(I,K,L,JV))
    151  100     CONTINUE
    152  10   CONTINUE
    153 C
    154  101  CONTINUE
    155 C
    156 C  boucle sur les niveaux intercouches de 1 a NIV-1
    157 C   (flux nul au sommet L=0 et a la base L=NIV)
    158 C
    159 C  calculate flux and moments between adjacent boxes
    160 C     (flux from LP to L if WGRI(L).lt.0, from L to LP if WGRI(L).gt.0)
    161 C  1- create temporary moments/masses for partial boxes in transit
    162 C  2- reajusts moments remaining in the box
    163 C
    164       DO 11 L=1,NIV-1
    165       LP=L+1
    166 C
    167       DO 110 I=1,LON
    168 C
    169          IF(WGRI(I,K,L).LT.0.) THEN
    170            FM(I,L)=-WGRI(I,K,L)*DTZ
    171            ALF(I)=FM(I,L)/SM(I,K,LP)
    172            SM(I,K,LP)=SM(I,K,LP)-FM(I,L)
    173          ELSE
    174            FM(I,L)=WGRI(I,K,L)*DTZ
    175            ALF(I)=FM(I,L)/SM(I,K,L)
    176            SM(I,K,L)=SM(I,K,L)-FM(I,L)
    177          ENDIF
    178 C
    179          ALFQ (I)=ALF(I)*ALF(I)
    180          ALF1 (I)=1.-ALF(I)
    181          ALF1Q(I)=ALF1(I)*ALF1(I)
    182 C
    183  110  CONTINUE
    184 C
    185       DO 111 JV=1,NTRA
    186       DO 1110 I=1,LON
    187 C
    188          IF(WGRI(I,K,L).LT.0.) THEN
    189 C
    190            F0(I,L,JV)=ALF (I)*( S0(I,K,LP,JV)-ALF1(I)*sz(I,K,LP,JV) )
    191            FZ(I,L,JV)=ALFQ(I)*sz(I,K,LP,JV)
    192            FX(I,L,JV)=ALF (I)*sx(I,K,LP,JV)
    193            FY(I,L,JV)=ALF (I)*sy(I,K,LP,JV)
    194 C
    195            S0(I,K,LP,JV)=S0(I,K,LP,JV)-F0(I,L,JV)
    196            sz(I,K,LP,JV)=ALF1Q(I)*sz(I,K,LP,JV)
    197            sx(I,K,LP,JV)=sx(I,K,LP,JV)-FX(I,L,JV)
    198            sy(I,K,LP,JV)=sy(I,K,LP,JV)-FY(I,L,JV)
    199 C
    200          ELSE
    201 C
    202            F0(I,L,JV)=ALF (I)*(S0(I,K,L,JV)+ALF1(I)*sz(I,K,L,JV) )
    203            FZ(I,L,JV)=ALFQ(I)*sz(I,K,L,JV)
    204            FX(I,L,JV)=ALF (I)*sx(I,K,L,JV)
    205            FY(I,L,JV)=ALF (I)*sy(I,K,L,JV)
    206 C
    207            S0(I,K,L,JV)=S0(I,K,L,JV)-F0(I,L,JV)
    208            sz(I,K,L,JV)=ALF1Q(I)*sz(I,K,L,JV)
    209            sx(I,K,L,JV)=sx(I,K,L,JV)-FX(I,L,JV)
    210            sy(I,K,L,JV)=sy(I,K,L,JV)-FY(I,L,JV)
    211 C
    212          ENDIF
    213 C
    214  1110 CONTINUE
    215  111  CONTINUE
    216 C
    217  11   CONTINUE
    218 C
    219 C  puts the temporary moments Fi into appropriate neighboring boxes
    220 C
    221       DO 12 L=1,NIV-1
    222       LP=L+1
    223 C
    224       DO 120 I=1,LON
    225 C
    226          IF(WGRI(I,K,L).LT.0.) THEN
    227            SM(I,K,L)=SM(I,K,L)+FM(I,L)
    228            ALF(I)=FM(I,L)/SM(I,K,L)
    229          ELSE
    230            SM(I,K,LP)=SM(I,K,LP)+FM(I,L)
    231            ALF(I)=FM(I,L)/SM(I,K,LP)
    232          ENDIF
    233 C
    234          ALF1(I)=1.-ALF(I)
    235          ALFQ(I)=ALF(I)*ALF(I)
    236          ALF1Q(I)=ALF1(I)*ALF1(I)
    237 C
    238  120  CONTINUE
    239 C
    240       DO 121 JV=1,NTRA
    241       DO 1210 I=1,LON
    242 C
    243          IF(WGRI(I,K,L).LT.0.) THEN
    244 C
    245            TEMPTM=-ALF(I)*S0(I,K,L,JV)+ALF1(I)*F0(I,L,JV)
    246            S0(I,K,L,JV)=S0(I,K,L,JV)+F0(I,L,JV)
    247            sz(I,K,L,JV)=ALF(I)*FZ(I,L,JV)+ALF1(I)*sz(I,K,L,JV)+3.*TEMPTM
    248            sx(I,K,L,JV)=sx(I,K,L,JV)+FX(I,L,JV)
    249            sy(I,K,L,JV)=sy(I,K,L,JV)+FY(I,L,JV)
    250 C
    251          ELSE
    252 C
    253            TEMPTM=ALF(I)*S0(I,K,LP,JV)-ALF1(I)*F0(I,L,JV)
    254            S0(I,K,LP,JV)=S0(I,K,LP,JV)+F0(I,L,JV)
    255            sz(I,K,LP,JV)=ALF(I)*FZ(I,L,JV)+ALF1(I)*sz(I,K,LP,JV)
    256      +                  +3.*TEMPTM
    257            sx(I,K,LP,JV)=sx(I,K,LP,JV)+FX(I,L,JV)
    258            sy(I,K,LP,JV)=sy(I,K,LP,JV)+FY(I,L,JV)
    259 C
    260          ENDIF
    261 C
    262  1210 CONTINUE
    263  121  CONTINUE
    264 C
    265  12   CONTINUE
    266 C
    267 C  fin de la boucle principale sur les latitudes
    268 C
    269  1    CONTINUE
    270 C
    271 C-------------------------------------------------------------
    272 C
    273 C ----------- AA Test en fin de ADVX ------ Controle des S*
    274 
    275 c     DO 9999 l = 1, llm
    276 c     DO 9999 j = 1, jjp1
    277 c     DO 9999 i = 1, iip1
    278 c        IF (S0(i,j,l,ntra).lt.0..and.LIMIT) THEN
    279 c           PRINT*, '-------------------'
    280 c           PRINT*, 'En fin de ADVZ'
    281 c           PRINT*,'S0(',i,j,l,')=',S0(i,j,l,ntra)
    282 c           print*, 'sx(',i,j,l,')=',sx(i,j,l,ntra)
    283 c           print*, 'sy(',i,j,l,')=',sy(i,j,l,ntra)
    284 c           print*, 'sz(',i,j,l,')=',sz(i,j,l,ntra)
    285 c           WRITE (*,*) 'On arrete !! - pbl en fin de ADVZ1'
    286 c            STOP
    287 c        ENDIF
    288  9999 CONTINUE
    289 
    290 C *** ------------------- bouclage cyclique  en X ------------
    291      
    292 c      DO l = 1,llm
    293 c         DO j = 1,jjp1
    294 c            SM(iip1,j,l) = SM(1,j,l)
    295 c            S0(iip1,j,l,ntra) = S0(1,j,l,ntra)
    296 C            sx(iip1,j,l,ntra) = sx(1,j,l,ntra)
    297 c            sy(iip1,j,l,ntra) = sy(1,j,l,ntra)
    298 c            sz(iip1,j,l,ntra) = sz(1,j,l,ntra)
    299 c         ENDDO
    300 c      ENDDO
    301            
    302 C-------------------------------------------------------------
    303 C *** Test : diag de la qqtite totale de traceur
    304 C            dans l'atmosphere avant l'advection en z
    305       DO l = 1,llm
    306          DO j = 1,jjp1
    307             DO i = 1,iim
    308 cIM 240305            sqf = sqf + S0(i,j,l,9)
    309                sqf = sqf + S0(i,j,l,ntra)
    310             ENDDO
    311          ENDDO
    312       ENDDO
    313       PRINT*,'-------- DIAG DANS ADVZ - SORTIE ---------'
    314       PRINT*,'sqf=', sqf
    315 
    316 C-------------------------------------------------------------
    317       RETURN
    318       END
    319 C_______________________________________________________________
    320 C_______________________________________________________________
     4SUBROUTINE advz(limit,dtz,w,sm,s0,sx,sy,sz)
     5  IMPLICIT NONE
     6
     7  !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
     8  !                                                                C
     9  !  first-order moments (FOM) advection of tracer in Z direction  C
     10  !                                                                C
     11  !  Source : Pascal Simon (Meteo,CNRM)                            C
     12  !  Adaptation : A.Armengaud (LGGE) juin 94                       C
     13  !                                                                C
     14  !                                                                C
     15  !  sont des arguments d'entree pour le s-pg...                   C
     16  !                                                                C
     17  !  dq est l'argument de sortie pour le s-pg                      C
     18  !                                                                C
     19  !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
     20  !
     21  !  parametres principaux du modele
     22  !
     23  include "dimensions.h"
     24  include "paramet.h"
     25
     26  ! INCLUDE "traceur.h"
     27
     28  !  Arguments :
     29  !  -----------
     30  !  dtz : frequence fictive d'appel du transport
     31  !  w : flux de masse en z en Pa.m2.s-1
     32
     33  INTEGER :: ntra
     34  PARAMETER (ntra = 1)
     35
     36  REAL :: dtz
     37  REAL :: w ( iip1,jjp1,llm )
     38
     39  !  moments: SM  total mass in each grid box
     40        ! S0  mass of tracer in each grid box
     41        ! Si  1rst order moment in i direction
     42  !
     43  REAL :: SM(iip1,jjp1,llm) &
     44        ,S0(iip1,jjp1,llm,ntra)
     45  REAL :: sx(iip1,jjp1,llm,ntra) &
     46        ,sy(iip1,jjp1,llm,ntra) &
     47        ,sz(iip1,jjp1,llm,ntra)
     48
     49
     50  !  Local :
     51  !  -------
     52
     53  !  mass fluxes across the boundaries (UGRI,VGRI,WGRI)
     54  !  mass fluxes in kg
     55  !  declaration :
     56
     57  REAL :: WGRI(iip1,jjp1,0:llm)
     58
     59  !
     60  !  the moments F are used as temporary  storage for
     61  !  portions of grid boxes in transit at the current latitude
     62  !
     63  REAL :: FM(iim,llm)
     64  REAL :: F0(iim,llm,ntra),FX(iim,llm,ntra)
     65  REAL :: FY(iim,llm,ntra),FZ(iim,llm,ntra)
     66  !
     67  !  work arrays
     68  !
     69  REAL :: ALF(iim),ALF1(iim),ALFQ(iim),ALF1Q(iim)
     70  REAL :: TEMPTM            ! Just temporal variable
     71  REAL :: sqi,sqf
     72  !
     73  LOGICAL :: LIMIT
     74  INTEGER :: lon,lat,niv
     75  INTEGER :: i,j,jv,k,l,lp
     76
     77  lon = iim
     78  lat = jjp1
     79  niv = llm
     80
     81  ! *** Test de passage d'arguments ******
     82
     83  ! DO 399 l = 1, llm
     84  ! DO 399 j = 1, jjp1
     85  ! DO 399 i = 1, iip1
     86  !    IF (S0(i,j,l,ntra) .lt. 0. ) THEN
     87  !       PRINT*,'S0(',i,j,l,')=',S0(i,j,l,ntra)
     88  !       print*, 'sx(',i,j,l,')=',sx(i,j,l,ntra)
     89  !       print*, 'sy(',i,j,l,')=',sy(i,j,l,ntra)
     90  !       print*, 'sz(',i,j,l,')=',sz(i,j,l,ntra)
     91  !       PRINT*, 'AIE !! debut ADVZ - pbl arg. passage dans ADVZ'
     92  !        STOP
     93  !    ENDIF
     94  399   CONTINUE
     95
     96  !-----------------------------------------------------------------
     97  ! *** Test : diag de la qqtite totale de traceur
     98         ! dans l'atmosphere avant l'advection en z
     99  sqi = 0.
     100  sqf = 0.
     101
     102  DO l = 1,llm
     103     DO j = 1,jjp1
     104        DO i = 1,iim
     105  !IM 240305            sqi = sqi + S0(i,j,l,9)
     106           sqi = sqi + S0(i,j,l,ntra)
     107        ENDDO
     108     ENDDO
     109  ENDDO
     110  PRINT*,'-------- DIAG DANS ADVZ - ENTREE ---------'
     111  PRINT*,'sqi=',sqi
     112
     113  !-----------------------------------------------------------------
     114  !  Interface : adaptation nouveau modele
     115  !  -------------------------------------
     116  !
     117  !  Conversion du flux de masse en kg.s-1
     118
     119  DO l = 1,llm
     120     DO j = 1,jjp1
     121        DO i = 1,iip1
     122         ! wgri (i,j,llm+1-l) =  w (i,j,l) / g
     123           wgri (i,j,llm+1-l) =  w (i,j,l)
     124          ! wgri (i,j,0) = 0.                ! a detruire ult.
     125          ! wgri (i,j,l) = 0.1               !    w (i,j,l)
     126          ! wgri (i,j,llm) = 0.              ! a detruire ult.
     127        END DO
     128     END DO
     129  END DO
     130     DO  j = 1,jjp1
     131        DO i = 1,iip1
     132           wgri(i,j,0)=0.
     133        enddo
     134     enddo
     135
     136  !-----------------------------------------------------------------
     137
     138  !  start here
     139  !  boucle sur les latitudes
     140  !
     141  DO K=1,LAT
     142  !
     143  !  place limits on appropriate moments before transport
     144  !  (if flux-limiting is to be applied)
     145  !
     146  IF(.NOT.LIMIT) GO TO 101
     147  !
     148  DO JV=1,NTRA
     149  DO L=1,NIV
     150     DO I=1,LON
     151        sz(I,K,L,JV)=SIGN(AMIN1(AMAX1(S0(I,K,L,JV),0.), &
     152              ABS(sz(I,K,L,JV))),sz(I,K,L,JV))
     153     END DO
     154  END DO
     155  END DO
     156  !
     157 101   CONTINUE
     158  !
     159  !  boucle sur les niveaux intercouches de 1 a NIV-1
     160  !   (flux nul au sommet L=0 et a la base L=NIV)
     161  !
     162  !  calculate flux and moments between adjacent boxes
     163  ! (flux from LP to L if WGRI(L).lt.0, from L to LP if WGRI(L).gt.0)
     164  !  1- create temporary moments/masses for partial boxes in transit
     165  !  2- reajusts moments remaining in the box
     166  !
     167  DO L=1,NIV-1
     168  LP=L+1
     169  !
     170  DO I=1,LON
     171  !
     172     IF(WGRI(I,K,L).LT.0.) THEN
     173       FM(I,L)=-WGRI(I,K,L)*DTZ
     174       ALF(I)=FM(I,L)/SM(I,K,LP)
     175       SM(I,K,LP)=SM(I,K,LP)-FM(I,L)
     176     ELSE
     177       FM(I,L)=WGRI(I,K,L)*DTZ
     178       ALF(I)=FM(I,L)/SM(I,K,L)
     179       SM(I,K,L)=SM(I,K,L)-FM(I,L)
     180     ENDIF
     181  !
     182     ALFQ (I)=ALF(I)*ALF(I)
     183     ALF1 (I)=1.-ALF(I)
     184     ALF1Q(I)=ALF1(I)*ALF1(I)
     185  !
     186  END DO
     187  !
     188  DO JV=1,NTRA
     189  DO I=1,LON
     190  !
     191     IF(WGRI(I,K,L).LT.0.) THEN
     192  !
     193       F0(I,L,JV)=ALF (I)*( S0(I,K,LP,JV)-ALF1(I)*sz(I,K,LP,JV) )
     194       FZ(I,L,JV)=ALFQ(I)*sz(I,K,LP,JV)
     195       FX(I,L,JV)=ALF (I)*sx(I,K,LP,JV)
     196       FY(I,L,JV)=ALF (I)*sy(I,K,LP,JV)
     197  !
     198       S0(I,K,LP,JV)=S0(I,K,LP,JV)-F0(I,L,JV)
     199       sz(I,K,LP,JV)=ALF1Q(I)*sz(I,K,LP,JV)
     200       sx(I,K,LP,JV)=sx(I,K,LP,JV)-FX(I,L,JV)
     201       sy(I,K,LP,JV)=sy(I,K,LP,JV)-FY(I,L,JV)
     202  !
     203     ELSE
     204  !
     205       F0(I,L,JV)=ALF (I)*(S0(I,K,L,JV)+ALF1(I)*sz(I,K,L,JV) )
     206       FZ(I,L,JV)=ALFQ(I)*sz(I,K,L,JV)
     207       FX(I,L,JV)=ALF (I)*sx(I,K,L,JV)
     208       FY(I,L,JV)=ALF (I)*sy(I,K,L,JV)
     209  !
     210       S0(I,K,L,JV)=S0(I,K,L,JV)-F0(I,L,JV)
     211       sz(I,K,L,JV)=ALF1Q(I)*sz(I,K,L,JV)
     212       sx(I,K,L,JV)=sx(I,K,L,JV)-FX(I,L,JV)
     213       sy(I,K,L,JV)=sy(I,K,L,JV)-FY(I,L,JV)
     214  !
     215     ENDIF
     216  !
     217  END DO
     218  END DO
     219  !
     220  END DO
     221  !
     222  !  puts the temporary moments Fi into appropriate neighboring boxes
     223  !
     224  DO L=1,NIV-1
     225  LP=L+1
     226  !
     227  DO I=1,LON
     228  !
     229     IF(WGRI(I,K,L).LT.0.) THEN
     230       SM(I,K,L)=SM(I,K,L)+FM(I,L)
     231       ALF(I)=FM(I,L)/SM(I,K,L)
     232     ELSE
     233       SM(I,K,LP)=SM(I,K,LP)+FM(I,L)
     234       ALF(I)=FM(I,L)/SM(I,K,LP)
     235     ENDIF
     236  !
     237     ALF1(I)=1.-ALF(I)
     238     ALFQ(I)=ALF(I)*ALF(I)
     239     ALF1Q(I)=ALF1(I)*ALF1(I)
     240  !
     241  END DO
     242  !
     243  DO JV=1,NTRA
     244  DO I=1,LON
     245  !
     246     IF(WGRI(I,K,L).LT.0.) THEN
     247  !
     248       TEMPTM=-ALF(I)*S0(I,K,L,JV)+ALF1(I)*F0(I,L,JV)
     249       S0(I,K,L,JV)=S0(I,K,L,JV)+F0(I,L,JV)
     250       sz(I,K,L,JV)=ALF(I)*FZ(I,L,JV)+ALF1(I)*sz(I,K,L,JV)+3.*TEMPTM
     251       sx(I,K,L,JV)=sx(I,K,L,JV)+FX(I,L,JV)
     252       sy(I,K,L,JV)=sy(I,K,L,JV)+FY(I,L,JV)
     253  !
     254     ELSE
     255  !
     256       TEMPTM=ALF(I)*S0(I,K,LP,JV)-ALF1(I)*F0(I,L,JV)
     257       S0(I,K,LP,JV)=S0(I,K,LP,JV)+F0(I,L,JV)
     258       sz(I,K,LP,JV)=ALF(I)*FZ(I,L,JV)+ALF1(I)*sz(I,K,LP,JV) &
     259             +3.*TEMPTM
     260       sx(I,K,LP,JV)=sx(I,K,LP,JV)+FX(I,L,JV)
     261       sy(I,K,LP,JV)=sy(I,K,LP,JV)+FY(I,L,JV)
     262  !
     263     ENDIF
     264  !
     265  END DO
     266  END DO
     267  !
     268  END DO
     269  !
     270  !  fin de la boucle principale sur les latitudes
     271  !
     272  END DO
     273  !
     274  !-------------------------------------------------------------
     275  !
     276  ! ----------- AA Test en fin de ADVX ------ Controle des S*
     277
     278  ! DO 9999 l = 1, llm
     279  ! DO 9999 j = 1, jjp1
     280  ! DO 9999 i = 1, iip1
     281  !    IF (S0(i,j,l,ntra).lt.0..and.LIMIT) THEN
     282  !       PRINT*, '-------------------'
     283  !       PRINT*, 'En fin de ADVZ'
     284  !       PRINT*,'S0(',i,j,l,')=',S0(i,j,l,ntra)
     285  !       print*, 'sx(',i,j,l,')=',sx(i,j,l,ntra)
     286  !       print*, 'sy(',i,j,l,')=',sy(i,j,l,ntra)
     287  !       print*, 'sz(',i,j,l,')=',sz(i,j,l,ntra)
     288  !       WRITE (*,*) 'On arrete !! - pbl en fin de ADVZ1'
     289  !        STOP
     290  !    ENDIF
     291 9999   CONTINUE
     292
     293  ! *** ------------------- bouclage cyclique  en X ------------
     294
     295   ! DO l = 1,llm
     296   !    DO j = 1,jjp1
     297   !       SM(iip1,j,l) = SM(1,j,l)
     298   !       S0(iip1,j,l,ntra) = S0(1,j,l,ntra)
     299   !       sx(iip1,j,l,ntra) = sx(1,j,l,ntra)
     300   !       sy(iip1,j,l,ntra) = sy(1,j,l,ntra)
     301   !       sz(iip1,j,l,ntra) = sz(1,j,l,ntra)
     302   !    ENDDO
     303   ! ENDDO
     304
     305  !-------------------------------------------------------------
     306  ! *** Test : diag de la qqtite totale de traceur
     307   !       dans l'atmosphere avant l'advection en z
     308  DO l = 1,llm
     309     DO j = 1,jjp1
     310        DO i = 1,iim
     311  !IM 240305            sqf = sqf + S0(i,j,l,9)
     312           sqf = sqf + S0(i,j,l,ntra)
     313        ENDDO
     314     ENDDO
     315  ENDDO
     316  PRINT*,'-------- DIAG DANS ADVZ - SORTIE ---------'
     317  PRINT*,'sqf=', sqf
     318
     319  !-------------------------------------------------------------
     320  RETURN
     321END SUBROUTINE advz
     322!_______________________________________________________________
     323!_______________________________________________________________
Note: See TracChangeset for help on using the changeset viewer.