Ignore:
Timestamp:
Aug 2, 2024, 9:58:25 PM (7 weeks ago)
Author:
abarral
Message:

Put dimensions.h and paramet.h into modules

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/advxp.f90

    r5134 r5159  
    44 SUBROUTINE ADVXP(LIMIT,DTX,PBARU,SM,S0,SSX,SY,SZ &
    55         ,SSXX,SSXY,SSXZ,SYY,SYZ,SZZ,ntra)
     6  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     7  USE lmdz_paramet
    68   IMPLICIT NONE
    79  !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
    … …  
    1012  !                                                                 C
    1113  !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
    12   !
     14
    1315  !  parametres principaux du modele
    1416  !
    15   INCLUDE "dimensions.h"
    16   INCLUDE "paramet.h"
     17
     18
    1719
    1820   INTEGER :: ntra
    1921   ! PARAMETER (ntra = 1)
    20   !
     22
    2123  !  definition de la grille du modele
    22   !
     24
    2325  REAL :: dtx
    2426  REAL :: pbaru ( iip1,jjp1,llm )
    25   !
     27
    2628  !  moments: SM  total mass in each grid box
    2729  !       S0  mass of tracer in each grid box
    2830  !       Si  1rst order moment in i direction
    2931  !       Sij 2nd  order moment in i and j directions
    30   !
     32
    3133  REAL :: SM(iip1,jjp1,llm) &
    3234        ,S0(iip1,jjp1,llm,ntra)
    … …  
    5254  !  Rem : VGRI et WGRI ne sont pas utilises dans
    5355  !  cette SUBROUTINE ( advection en x uniquement )
    54   !
    55   !
     56
     57
    5658  !  Tij are the moments for the current latitude and level
    57   !
     59
    5860  REAL :: TM (iim)
    5961  REAL :: T0 (iim,NTRA),TX (iim,NTRA)
    … …  
    6264  REAL :: TXZ(iim,NTRA),TYY(iim,NTRA)
    6365  REAL :: TYZ(iim,NTRA),TZZ(iim,NTRA)
    64   !
     66
    6567  !  the moments F are similarly defined and used as temporary
    6668  !  storage for portions of the grid boxes in transit
    67   !
     69
    6870  REAL :: FM (iim)
    6971  REAL :: F0 (iim,NTRA),FX (iim,NTRA)
    … …  
    7274  REAL :: FXZ(iim,NTRA),FYY(iim,NTRA)
    7375  REAL :: FYZ(iim,NTRA),FZZ(iim,NTRA)
    74   !
     76
    7577  !  work arrays
    76   !
     78
    7779  REAL :: ALF (iim),ALF1(iim),ALFQ(iim),ALF1Q(iim)
    7880  REAL :: ALF2(iim),ALF3(iim),ALF4(iim)
    79   !
     81
    8082  REAL :: SMNEW(iim),UEXT(iim)
    8183  REAL :: sqi,sqf
    … …  
    111113  ! *** Test : diagnostique de la qtite totale de traceur
    112114   !       dans l'atmosphere avant l'advection
    113   !
     115
    114116  sqi =0.
    115117  sqf =0.
    116   !
     118
    117119  DO l = 1, llm
    118120  DO j = 1, jjp1
    … …  
    144146  !  Interface : adaptation nouveau modele
    145147  !  -------------------------------------
    146   !
     148
    147149  !  ---------------------------------------------------------
    148150  !  Conversion des flux de masses en kg/s
    … …  
    160162  !  ---------------------------------------------------------
    161163  !  start here
    162   !
     164
    163165  !  boucle principale sur les niveaux et les latitudes
    164   !
     166
    165167  DO L=1,NIV
    166168  DO K=lati,latf
    167169
    168   !
     170
    169171  !  initialisation
    170   !
     172
    171173  !  program assumes periodic boundaries in X
    172   !
     174
    173175  DO I=2,LON
    174176     SMNEW(I)=SM(I,K,L)+(UGRI(I-1,K,L)-UGRI(I,K,L))*DTX
    175177  END DO
    176178  SMNEW(1)=SM(1,K,L)+(UGRI(LON,K,L)-UGRI(1,K,L))*DTX
    177   !
     179
    178180  !  modifications for extended polar zones
    179   !
     181
    180182  NUMK=NUM(K)
    181183  LONK=LON/NUMK
    182   !
     184
    183185  IF(NUMK>1) THEN
    184   !
     186
    185187  DO I=1,LON
    186188     TM(I)=0.
    … …  
    200202  END DO
    201203  END DO
    202   !
     204
    203205  DO I2=1,NUMK
    204   !
     206
    205207     DO I=1,LONK
    206208        I3=(I-1)*NUMK+I2
    … …  
    213215        ALF3(I)=ALF(I)*ALF1(I)
    214216  END DO
    215   !
     217
    216218     DO JV=1,NTRA
    217219     DO I=1,LONK
    … …  
    233235  END DO
    234236  END DO
    235   !
    236   END DO
    237   !
     237
     238  END DO
     239
    238240  ELSE
    239   !
     241
    240242  DO I=1,LON
    241243     TM(I)=SM(I,K,L)
    … …  
    255257  END DO
    256258  END DO
    257   !
     259
    258260  ENDIF
    259   !
     261
    260262  DO I=1,LONK
    261263     UEXT(I)=UGRI(I*NUMK,K,L)
    262264  END DO
    263   !
     265
    264266  !  place limits on appropriate moments before transport
    265267  !  (if flux-limiting is to be applied)
    266   !
     268
    267269  IF(.NOT.LIMIT) GO TO 13
    268   !
     270
    269271  DO JV=1,NTRA
    270272  DO I=1,LONK
    … …  
    287289  END DO
    288290  END DO
    289   !
     291
    290292 13   CONTINUE
    291   !
     293
    292294  !  calculate flux and moments between adjacent boxes
    293295  !  1- create temporary moments/masses for partial boxes in transit
    294296  !  2- reajusts moments remaining in the box
    295   !
     297
    296298  !  flux from IP to I if U(I).lt.0
    297   !
     299
    298300  DO I=1,LONK-1
    299301     IF(UEXT(I)<0.) THEN
    … …  
    303305     ENDIF
    304306  END DO
    305   !
     307
    306308  I=LONK
    307309  IF(UEXT(I)<0.) THEN
    … …  
    310312    TM(1)=TM(1)-FM(I)
    311313  ENDIF
    312   !
     314
    313315  !  flux from I to IP if U(I).gt.0
    314   !
     316
    315317  DO I=1,LONK
    316318     IF(UEXT(I)>=0.) THEN
    … …  
    320322     ENDIF
    321323  END DO
    322   !
     324
    323325  DO I=1,LONK
    324326     ALFQ(I)=ALF(I)*ALF(I)
    … …  
    329331     ALF4(I)=ALF1(I)*ALF1Q(I)
    330332  END DO
    331   !
     333
    332334  DO JV=1,NTRA
    333335  DO I=1,LONK-1
    334   !
     336
    335337     IF(UEXT(I)<0.) THEN
    336   !
     338
    337339       F0 (I,JV)=ALF (I)* ( T0(I+1,JV)-ALF1(I)* &
    338340             ( TX(I+1,JV)-ALF2(I)*TXX(I+1,JV) ) )
    … …  
    346348       FYZ(I,JV)=ALF (I)*TYZ(I+1,JV)
    347349       FZZ(I,JV)=ALF (I)*TZZ(I+1,JV)
    348   !
     350
    349351       T0 (I+1,JV)=T0(I+1,JV)-F0(I,JV)
    350352       TX (I+1,JV)=ALF1Q(I)*(TX(I+1,JV)+3.*ALF(I)*TXX(I+1,JV))
    … …  
    357359       TXY(I+1,JV)=ALF1Q(I)*TXY(I+1,JV)
    358360       TXZ(I+1,JV)=ALF1Q(I)*TXZ(I+1,JV)
    359   !
    360      ENDIF
    361   !
    362   END DO
    363   END DO
    364   !
     361
     362     ENDIF
     363
     364  END DO
     365  END DO
     366
    365367  I=LONK
    366368  IF(UEXT(I)<0.) THEN
    367   !
     369
    368370    DO JV=1,NTRA
    369   !
     371
    370372       F0 (I,JV)=ALF (I)* ( T0(1,JV)-ALF1(I)* &
    371373             ( TX(1,JV)-ALF2(I)*TXX(1,JV) ) )
    … …  
    379381       FYZ(I,JV)=ALF (I)*TYZ(1,JV)
    380382       FZZ(I,JV)=ALF (I)*TZZ(1,JV)
    381   !
     383
    382384       T0 (1,JV)=T0(1,JV)-F0(I,JV)
    383385       TX (1,JV)=ALF1Q(I)*(TX(1,JV)+3.*ALF(I)*TXX(1,JV))
    … …  
    390392       TXY(1,JV)=ALF1Q(I)*TXY(1,JV)
    391393       TXZ(1,JV)=ALF1Q(I)*TXZ(1,JV)
    392   !
    393   END DO
    394   !
     394
     395  END DO
     396
    395397  ENDIF
    396   !
    397   DO JV=1,NTRA
    398   DO I=1,LONK
    399   !
     398
     399  DO JV=1,NTRA
     400  DO I=1,LONK
     401
    400402     IF(UEXT(I)>=0.) THEN
    401   !
     403
    402404       F0 (I,JV)=ALF (I)* ( T0(I,JV)+ALF1(I)* &
    403405             ( TX(I,JV)+ALF2(I)*TXX(I,JV) ) )
    … …  
    411413       FYZ(I,JV)=ALF (I)*TYZ(I,JV)
    412414       FZZ(I,JV)=ALF (I)*TZZ(I,JV)
    413   !
     415
    414416       T0 (I,JV)=T0(I,JV)-F0(I,JV)
    415417       TX (I,JV)=ALF1Q(I)*(TX(I,JV)-3.*ALF(I)*TXX(I,JV))
    … …  
    422424       TXY(I,JV)=ALF1Q(I)*TXY(I,JV)
    423425       TXZ(I,JV)=ALF1Q(I)*TXZ(I,JV)
    424   !
    425      ENDIF
    426   !
    427   END DO
    428   END DO
    429   !
     426
     427     ENDIF
     428
     429  END DO
     430  END DO
     431
    430432  !  puts the temporary moments Fi into appropriate neighboring boxes
    431   !
     433
    432434  DO I=1,LONK
    433435     IF(UEXT(I)<0.) THEN
    … …  
    436438     ENDIF
    437439  END DO
    438   !
     440
    439441  DO I=1,LONK-1
    440442     IF(UEXT(I)>=0.) THEN
    … …  
    443445     ENDIF
    444446  END DO
    445   !
     447
    446448  I=LONK
    447449  IF(UEXT(I)>=0.) THEN
    … …  
    449451    ALF(I)=FM(I)/TM(1)
    450452  ENDIF
    451   !
     453
    452454  DO I=1,LONK
    453455     ALF1(I)=1.-ALF(I)
    … …  
    457459     ALF3(I)=ALF(I)*ALF1(I)
    458460  END DO
    459   !
    460   DO JV=1,NTRA
    461   DO I=1,LONK
    462   !
     461
     462  DO JV=1,NTRA
     463  DO I=1,LONK
     464
    463465     IF(UEXT(I)<0.) THEN
    464   !
     466
    465467       TEMPTM=-ALF(I)*T0(I,JV)+ALF1(I)*F0(I,JV)
    466468       T0 (I,JV)=T0(I,JV)+F0(I,JV)
    … …  
    477479       TYZ(I,JV)=TYZ(I,JV)+FYZ(I,JV)
    478480       TZZ(I,JV)=TZZ(I,JV)+FZZ(I,JV)
    479   !
    480      ENDIF
    481   !
    482   END DO
    483   END DO
    484   !
     481
     482     ENDIF
     483
     484  END DO
     485  END DO
     486
    485487  DO JV=1,NTRA
    486488  DO I=1,LONK-1
    487   !
     489
    488490     IF(UEXT(I)>=0.) THEN
    489   !
     491
    490492       TEMPTM=ALF(I)*T0(I+1,JV)-ALF1(I)*F0(I,JV)
    491493       T0 (I+1,JV)=T0(I+1,JV)+F0(I,JV)
    … …  
    502504       TYZ(I+1,JV)=TYZ(I+1,JV)+FYZ(I,JV)
    503505       TZZ(I+1,JV)=TZZ(I+1,JV)+FZZ(I,JV)
    504   !
    505      ENDIF
    506   !
    507   END DO
    508   END DO
    509   !
     506
     507     ENDIF
     508
     509  END DO
     510  END DO
     511
    510512  I=LONK
    511513  IF(UEXT(I)>=0.) THEN
    … …  
    527529  END DO
    528530  ENDIF
    529   !
     531
    530532  !  retour aux mailles d'origine (passage des Tij aux Sij)
    531   !
     533
    532534  IF(NUMK>1) THEN
    533   !
     535
    534536  DO I2=1,NUMK
    535   !
     537
    536538     DO I=1,LONK
    537   !
     539
    538540        I3=I2+(I-1)*NUMK
    539541        SM(I3,K,L)=SMNEW(I3)
    540542        ALF(I)=SMNEW(I3)/TM(I)
    541543        TM(I)=TM(I)-SMNEW(I3)
    542   !
     544
    543545        ALFQ(I)=ALF(I)*ALF(I)
    544546        ALF1(I)=1.-ALF(I)
    … …  
    547549        ALF3(I)=ALF(I)*ALFQ(I)
    548550        ALF4(I)=ALF1(I)*ALF1Q(I)
    549   !
    550   END DO
    551   !
     551
     552  END DO
     553
    552554     DO JV=1,NTRA
    553555     DO I=1,LONK
    554   !
     556
    555557        I3=I2+(I-1)*NUMK
    556558        S0 (I3,K,L,JV)=ALF (I)* ( T0(I,JV)-ALF1(I)* &
    … …  
    565567        SYZ(I3,K,L,JV)=ALF (I)*TYZ(I,JV)
    566568        SZZ(I3,K,L,JV)=ALF (I)*TZZ(I,JV)
    567   !
     569
    568570  !   reajusts moments remaining in the box
    569   !
     571
    570572        T0 (I,JV)=T0(I,JV)-S0(I3,K,L,JV)
    571573        TX (I,JV)=ALF1Q(I)*(TX(I,JV)+3.*ALF(I)*TXX(I,JV))
    … …  
    578580        TXY(I,JV)=ALF1Q(I)*TXY(I,JV)
    579581        TXZ(I,JV)=ALF1Q(I)*TXZ(I,JV)
    580   !
    581   END DO
    582   END DO
    583   !
    584   END DO
    585   !
     582
     583  END DO
     584  END DO
     585
     586  END DO
     587
    586588  ELSE
    587   !
     589
    588590  DO I=1,LON
    589591     SM(I,K,L)=TM(I)
    … …  
    603605  END DO
    604606  END DO
    605   !
     607
    606608  ENDIF
    607   !
    608   END DO
    609   END DO
    610   !
     609
     610  END DO
     611  END DO
     612
    611613  ! ----------- AA Test en fin de ADVX ------ Controle des S*
    612614
Note: See TracChangeset for help on using the changeset viewer.