Ignore:
Timestamp:
Jul 22, 2024, 6:53:44 PM (17 months ago)
Author:
abarral
Message:

Remove CRAY key (obsolete calls to functions that don't exist anymore, bugs in some implementations, irrelevant now)
Replace usage of CPP_XIOS key by using_xios logical
Remove always unused testcpu bits
Replace most uses of CPP_StratAer by the corresponding logical defined in lmdz_cppkeys_wrapper.F90 [this breaks iso compilation because phyiso doesn't define all aerosols - to be fixed later]
Replaces uses of include "yomcst.h" by the lmdz_yomcst.f90 module in .[fF]90 files

Location:
LMDZ6/branches/Amaury_dev/libf/dyn3dmem
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlsplt_loc.F

    r5082 r5098  
    44      RECURSIVE SUBROUTINE vlx_loc(q,pente_max,masse,u_m,ijb_x,ije_x,iq)
    55
    6 c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
     6c     Auteurs:   P.Le Van, F.Hourdin, F.Forget
    77c
    88c    ********************************************************************
    … …  
    2828      REAL u_m( ijb_u:ije_u,llm),pbarv( iip1,jjb_v:jje_v,llm)
    2929      REAL q(ijb_u:ije_u,llm,nqtot) ! CRisi: ajout dimension nqtot
    30       REAL w(ijb_u:ije_u,llm) 
     30      REAL w(ijb_u:ije_u,llm)
    3131      INTEGER iq ! CRisi
    3232c
    33 c      Local 
     33c      Local
    3434c   ---------
    3535c
    … …  
    4949
    5050      REAL      SSUM
    51       EXTERNAL  SSUM
    5251
    5352      REAL z1,z2,z3
    5453
    5554      INTEGER ijb,ije,ijb_x,ije_x
    56      
     55
    5756      !write(*,*) 'vlsplt 58: entree dans vlx_loc, iq,ijb_x=',
    5857!     &   iq,ijb_x
    … …  
    6160      ijb=ijb_x
    6261      ije=ije_x
    63        
     62
    6463      if (pole_nord.and.ijb==1) ijb=ijb+iip1
    6564      if (pole_sud.and.ije==ip1jmp1)  ije=ije-iip1
    66          
     65
    6766      IF (pente_max>-1.e-5) THEN
    6867c       IF (pente_max.gt.10) THEN
    … …  
    7271      ! on a besoin de q entre ijb et ije
    7372c   calcul de la pente aux points u
    74 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)         
     73c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    7574         DO l = 1, llm
    76            
     75
    7776            DO ij=ijb,ije-1
    7877               dxqu(ij)=q(ij+1,l,iq)-q(ij,l,iq)
    … …  
    9695c limitation subtile
    9796c    ,      min(adxqu(ij-1)/sigu(ij-1),adxqu(ij)/(1.-sigu(ij)))
    98          
     97
    9998
    10099            ENDDO
    … …  
    105104
    106105            DO ij=ijb+1,ije
    107 #ifdef CRAY
    108                dxq(ij,l)=
    109      ,         cvmgp(dxqu(ij-1)+dxqu(ij),0.,dxqu(ij-1)*dxqu(ij))
    110 #else
    111106               IF(dxqu(ij-1)*dxqu(ij)>0) THEN
    112107                  dxq(ij,l)=dxqu(ij-1)+dxqu(ij)
    … …  
    115110                  dxq(ij,l)=0.
    116111               ENDIF
    117 #endif
    118112               dxq(ij,l)=0.5*dxq(ij,l)
    119113               dxq(ij,l)=
    … …  
    172166c   calcul des flux a gauche et a droite
    173167
    174 #ifdef CRAY
    175 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    176       DO l=1,llm
    177        DO ij=ijb,ije-1
    178           zdum(ij,l)=cvmgp(1.-u_m(ij,l)/masse(ij,l,iq),
    179      ,                     1.+u_m(ij,l)/masse(ij+1,l,iq),
    180      ,                     u_m(ij,l,iq))
    181           zdum(ij,l)=0.5*zdum(ij,l)
    182           u_mq(ij,l)=cvmgp(
    183      ,                q(ij,l,iq)+zdum(ij,l)*dxq(ij,l),
    184      ,                q(ij+1,l,iq)-zdum(ij,l)*dxq(ij+1,l),
    185      ,                u_m(ij,l))
    186           u_mq(ij,l)=u_m(ij,l)*u_mq(ij,l)
    187        ENDDO
    188       ENDDO
    189 c$OMP END DO NOWAIT
    190 #else
     168
    191169c   on cumule le flux correspondant a toutes les mailles dont la masse
    192170c   au travers de la paroi pENDant le pas de temps.
    … …  
    209187      ENDDO
    210188c$OMP END DO NOWAIT
    211 #endif
    212 
    213 c       go to 9999
     189
    214190c   detection des points ou on advecte plus que la masse de la
    215191c   maille
    … …  
    234210c$OMP END DO NOWAIT
    235211c        print*,'Ok test 2'
    236        
     212
    237213
    238214c   traitement special pour le cas ou on advecte en longitude plus que le
    … …  
    313289         ENDDO
    314290c$OMP END DO NOWAIT
    315 cym      ENDIF  ! n0.gt.0
    316 9999    continue
     291cym      ENDIF  ! n0.gt.0
    317292
    318293c   bouclage en latitude
    … …  
    346321              Ratio(ij,l,iq2)=min_ratio
    347322            endif
    348           enddo   
     323          enddo
    349324        enddo
    350325c$OMP END DO NOWAIT
    … …  
    377352
    378353! retablir les fils en rapport de melange par rapport a l'air:
    379       ! On calcule q entre ijb+1 et ije -> on fait pareil pour ratio 
     354      ! On calcule q entre ijb+1 et ije -> on fait pareil pour ratio
    380355      ! puis on boucle en longitude
    381356      do ifils=1,tracers(iq)%nqDescen
    382357        iq2=tracers(iq)%iqDescen(ifils)
    383 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
     358c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    384359        DO l=1,llm
    385360          DO ij=ijb+1,ije
    386             q(ij,l,iq2)=q(ij,l,iq)*Ratio(ij,l,iq2)           
     361            q(ij,l,iq2)=q(ij,l,iq)*Ratio(ij,l,iq2)
    387362          enddo
    388363          DO ij=ijb+iip1-1,ije,iip1
    … …  
    404379      RECURSIVE SUBROUTINE vly_loc(q,pente_max,masse,masse_adv_v,iq)
    405380c
    406 c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
     381c     Auteurs:   P.Le Van, F.Hourdin, F.Forget
    407382c
    408383c    ********************************************************************
    … …  
    416391      USE parallel_lmdz
    417392      USE infotrac, ONLY : nqtot,tracers, ! CRisi                 &
    418      &                     min_qParent,min_qMass,min_ratio ! MVals et CRisi   
     393     &                     min_qParent,min_qMass,min_ratio ! MVals et CRisi
    419394      USE comconst_mod, ONLY: pi
    420395      IMPLICIT NONE
    … …  
    432407      INTEGER iq ! CRisi
    433408c
    434 c      Local 
     409c      Local
    435410c   ---------
    436411c
    … …  
    444419      REAL qpns,qpsn,appn,apps,dyn1,dys1,dyn2,dys2,newmasse,fn,fs
    445420c     REAL newq,oldmasse
    446       Logical extremum,first,testcpu
     421      Logical extremum,first
    447422      REAL temps0,temps1,temps2,temps3,temps4,temps5,second
    448423      SAVE temps0,temps1,temps2,temps3,temps4,temps5
    449424c$OMP THREADPRIVATE(temps0,temps1,temps2,temps3,temps4,temps5)
    450       SAVE first,testcpu
    451 c$OMP THREADPRIVATE(first,testcpu)
     425      SAVE first
     426c$OMP THREADPRIVATE(first)
    452427
    453428      REAL convpn,convps,convmpn,convmps
    … …  
    467442      EXTERNAL  SSUM
    468443
    469       DATA first,testcpu/.true.,.false./
     444      DATA first/.true./
    470445      DATA temps0,temps1,temps2,temps3,temps4,temps5/0.,0.,0.,0.,0.,0./
    471446      INTEGER ijb,ije
    … …  
    473448
    474449      ijb=ij_begin-2*iip1
    475       ije=ij_end+2*iip1 
     450      ije=ij_end+2*iip1
    476451      if (pole_nord) ijb=ij_begin
    477452      if (pole_sud)  ije=ij_end
    … …  
    491466         sinlondlon(1)=sinlondlon(iip1)
    492467         airej2 = SSUM( iim, aire(iip2), 1 )
    493          airejjm= SSUM( iim, aire(ip1jm -iim), 1 ) 
     468         airejjm= SSUM( iim, aire(ip1jm -iim), 1 )
    494469      ENDIF
    495470
    … …  
    497472c       PRINT*,'CALCUL EN LATITUDE'
    498473
    499 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     474c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    500475      DO l = 1, llm
    501476c
    … …  
    507482c   de latitude autour du pole (qpns pour le pole nord et qpsn pour
    508483c    le pole nord) qui sera utilisee pour evaluer les pentes au pole.
    509      
     484
    510485      if (pole_nord) then
    511486        DO i = 1, iim
    … …  
    514489        qpns   = SSUM( iim,  airescb ,1 ) / airej2
    515490      endif
    516      
     491
    517492      if (pole_sud) then
    518493        DO i = 1, iim
    … …  
    521496        qpsn   = SSUM( iim,  airesch ,1 ) / airejjm
    522497      endif
    523      
     498
    524499c   calcul des pentes aux points v
    525500
    … …  
    528503      if (pole_nord) ijb=ij_begin
    529504      if (pole_sud)  ije=ij_end-iip1
    530      
     505
    531506      ! on a besoin de q entre ij_begin-2*iip1 et ij_end+2*iip1
    532507      ! Si pole sud, entre ij_begin-2*iip1 et ij_end
    … …  
    536511         adyqv(ij)=abs(dyqv(ij))
    537512      ENDDO
    538  
     513
    539514
    540515c   calcul des pentes aux points scalaires
    … …  
    543518      if (pole_nord) ijb=ij_begin+iip1
    544519      if (pole_sud)  ije=ij_end-iip1
    545      
     520
    546521      DO ij=ijb,ije
    547522         dyq(ij,l)=.5*(dyqv(ij-iip1)+dyqv(ij))
    … …  
    555530           dyq(ij,l)=qpns-q(ij+iip1,l,iq)
    556531        ENDDO
    557        
     532
    558533        dyn1=0.
    559534        dyn2=0.
    … …  
    565540          dyq(ij,l)=dyn1*sinlon(ij)+dyn2*coslon(ij)
    566541        ENDDO
    567        
     542
    568543        DO ij=1,iip1
    569544         dyq(ij,l)=0.
    … …  
    571546c ym tout cela ne sert pas a grand chose
    572547      ENDIF
    573      
     548
    574549      IF (pole_sud) THEN
    575550
    … …  
    589564          dyq(ip1jm+ij,l)=dys1*sinlon(ij)+dys2*coslon(ij)
    590565        ENDDO
    591        
     566
    592567        DO ij=1,iip1
    593568         dyq(ip1jm+ij,l)=0.
    … …  
    619594
    620595CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
    621 C  En memoire de dIFferents tests sur la 
     596C  En memoire de dIFferents tests sur la
    622597C  limitation des pentes aux poles.
    623598CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
    … …  
    732707      ijem=ij_end+iip1
    733708      if (pole_nord) ijb=ij_begin
    734       if (pole_sud)  ije=ij_end 
     709      if (pole_sud)  ije=ij_end
    735710      if (pole_nord) ijbm=ij_begin
    736711      if (pole_sud)  ijem=ij_end
    … …  
    738713      do ifils=1,tracers(iq)%nqDescen
    739714        iq2=tracers(iq)%iqDescen(ifils)
    740 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 
     715c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    741716        DO l=1,llm
    742717        ! modif des bornes: CRisi 16 nov 2020
    743718        ! d'abord masse avec bornes corrigées
    744           DO ij=ijbm,ijem 
     719          DO ij=ijbm,ijem
    745720          !MVals: veiller a ce qu'on n'ait pas de denominateur nul
    746721            masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),min_qMass)
    … …  
    753728              Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
    754729            else
    755               Ratio(ij,l,iq2)=min_ratio 
    756             endif     
    757           enddo !DO ij=ijbm,ijem 
     730              Ratio(ij,l,iq2)=min_ratio
     731            endif
     732          enddo !DO ij=ijbm,ijem
    758733        enddo !DO l=1,llm
    759734c$OMP END DO NOWAIT
    … …  
    765740      enddo
    766741! end CRisi
    767      
     742
    768743      ijb=ij_begin
    769744      ije=ij_end
    770745      if (pole_nord) ijb=ij_begin+iip1
    771746      if (pole_sud)  ije=ij_end-iip1
    772      
    773 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     747
     748c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    774749      DO l=1,llm
    775750         DO ij=ijb,ije
    … …  
    801776           enddo
    802777         endif
    803          
     778
    804779c        convps=-SSUM(iim,qbyv(ip1jm-iim,l),1)/apols
    805780c        convmps=-ssum(iim,masse_adv_v(ip1jm-iim,l),1)/apols
    806          
     781
    807782         if (pole_sud) then
    808          
     783
    809784           convps=-SSUM(iim,qbyv(ip1jm-iim,l),1)
    810785           convmps=-ssum(iim,masse_adv_v(ip1jm-iim,l),1)
    … …  
    854829      do ifils=1,tracers(iq)%nqDescen
    855830        iq2=tracers(iq)%iqDescen(ifils)
    856 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
     831c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    857832        DO l=1,llm
    858833          DO ij=ijb,ije
    859             q(ij,l,iq2)=q(ij,l,iq)*Ratio(ij,l,iq2)           
     834            q(ij,l,iq2)=q(ij,l,iq)*Ratio(ij,l,iq2)
    860835          enddo
    861836        enddo
    … …  
    866841      RETURN
    867842      END
    868      
    869      
    870      
     843
     844
     845
    871846      RECURSIVE SUBROUTINE vlz_loc(q,pente_max,masse,w,ijb_x,ije_x,iq)
    872847c
    873 c     Auteurs:   P.Le Van, F.Hourdin, F.Forget 
     848c     Auteurs:   P.Le Van, F.Hourdin, F.Forget
    874849c
    875850c    ********************************************************************
    … …  
    885860      USE infotrac, ONLY : nqtot,tracers, ! CRisi                 &
    886861     &                     min_qParent,min_qMass,min_ratio ! MVals et CRisi
    887      
     862
    888863      IMPLICIT NONE
    889864c
    … …  
    900875      INTEGER iq
    901876c
    902 c      Local 
     877c      Local
    903878c   ---------
    904879c
    … …  
    915890      REAL sigw
    916891
    917       LOGICAL testcpu
    918       SAVE testcpu
    919 c$OMP THREADPRIVATE(testcpu)
    920892      REAL temps0,temps1,temps2,temps3,temps4,temps5,second
    921893      SAVE temps0,temps1,temps2,temps3,temps4,temps5
    … …  
    923895
    924896      REAL      SSUM
    925       EXTERNAL  SSUM
    926 
    927       DATA testcpu/.false./
     897
    928898      DATA temps0,temps1,temps2,temps3,temps4,temps5/0.,0.,0.,0.,0.,0./
    929899      INTEGER ijb,ije,ijb_x,ije_x
    … …  
    933903      !REAL masseq(ijb_u:ije_u,llm,nqtot),Ratio(ijb_u:ije_u,llm,nqtot) ! CRisi
    934904      ! Ces varibles doivent être déclarées en pointer et en save dans
    935       ! vlz_loc si on veut qu'elles soient vues par tous les threads. 
     905      ! vlz_loc si on veut qu'elles soient vues par tous les threads.
    936906      INTEGER ifils,iq2 ! CRisi
    937907
    … …  
    939909      IF (first) THEN
    940910       first=.FALSE.
    941       ENDIF             
     911      ENDIF
    942912c    On oriente tout dans le sens de la pression c'est a dire dans le
    943913c    sens de W
    944914
    945915      !write(*,*) 'vlsplt 926: entree dans vlz_loc, iq=',iq
    946 #ifdef BIDON
    947       IF(testcpu) THEN
    948          temps0=second(0.)
    949       ENDIF
    950 #endif
    951916
    952917      ijb=ijb_x
    953918      ije=ije_x
    954919
    955 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
     920c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    956921      DO l=2,llm
    957922         DO ij=ijb,ije
    … …  
    965930      DO l=2,llm-1
    966931         DO ij=ijb,ije
    967 #ifdef CRAY
    968             dzq(ij,l)=0.5*
    969      ,      cvmgp(dzqw(ij,l)+dzqw(ij,l+1),0.,dzqw(ij,l)*dzqw(ij,l+1))
    970 #else
    971932            IF(dzqw(ij,l)*dzqw(ij,l+1)>0.) THEN
    972933                dzq(ij,l)=0.5*(dzqw(ij,l)+dzqw(ij,l+1))
    … …  
    974935                dzq(ij,l)=0.
    975936            ENDIF
    976 #endif
    977937            dzqmax=pente_max*min(adzqw(ij,l),adzqw(ij,l+1))
    978938            dzq(ij,l)=sign(min(abs(dzq(ij,l)),dzqmax),dzq(ij,l))
    … …  
    988948c$OMP END MASTER
    989949c$OMP BARRIER
    990 #ifdef BIDON
    991       IF(testcpu) THEN
    992          temps1=temps1+second(0.)-temps0
    993       ENDIF
    994 #endif
    995950
    996951!--------------------------------------------------------
    … …  
    1008963         ENDDO
    1009964      ENDDO
    1010 c$OMP END DO NOWAIT   
     965c$OMP END DO NOWAIT
    1011966
    1012967c ---------------------------------------------------------------
    … …  
    1041996         ENDDO
    1042997       ENDDO
    1043 c$OMP END DO NOWAIT   
    1044        !write(*,*) 'vlz 1001'   
     998c$OMP END DO NOWAIT
     999       !write(*,*) 'vlz 1001'
    10451000
    10461001      ELSE ! countcfl>=1
    … …  
    10791034c  on itère jusqu'à ce que tous les poins satisfassent
    10801035c  le critère
    1081       DO WHILE (countcfl>=1) 
     1036      DO WHILE (countcfl>=1)
    10821037        IF (prt_level>9) THEN
    10831038          WRITE(lunout,*)'On viole le CFL Vertical sur ',countcfl,' pts'
    … …  
    11301085         ENDDO
    11311086       ENDDO
    1132 c$OMP END DO NOWAIT   
     1087c$OMP END DO NOWAIT
    11331088
    11341089
    … …  
    11621117            !wq(ij,l,iq2)=wq(ij,l,iq) ! correction bug le 15mai2015
    11631118            w(ij,l,iq2)=wq(ij,l,iq)
    1164           enddo   
     1119          enddo
    11651120        enddo
    11661121c$OMP END DO NOWAIT
    … …  
    11721127        call vlz_loc(Ratio,pente_max,masse,w,ijb_x,ije_x,iq2)
    11731128      enddo
    1174 ! end CRisi 
     1129! end CRisi
    11751130
    11761131! CRisi: On rajoute ici une barrière car on veut être sur que tous les
    … …  
    11901145c$OMP END DO NOWAIT
    11911146
    1192      
     1147
    11931148! retablir les fils en rapport de melange par rapport a l'air:
    11941149      do ifils=1,tracers(iq)%nqDescen
    11951150        iq2=tracers(iq)%iqDescen(ifils)
    1196 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
     1151c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    11971152        DO l=1,llm
    11981153          DO ij=ijb,ije
    1199             q(ij,l,iq2)=q(ij,l,iq)*Ratio(ij,l,iq2)           
     1154            q(ij,l,iq2)=q(ij,l,iq)*Ratio(ij,l,iq2)
    12001155          enddo
    12011156        enddo

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlspltqs_loc.F

    r5081 r5098  
    1313      USE parallel_lmdz
    1414      USE infotrac, ONLY : nqtot,tracers, ! CRisi                 &
    15      &                     min_qParent,min_qMass,min_ratio ! MVals et CRisi
     15     &                     min_qParent,min_qMass,min_ratio ! MVals et CRisi7
    1616      IMPLICIT NONE
    1717c
    … …  
    9191c limitation subtile
    9292c    ,      min(adxqu(ij-1)/sigu(ij-1),adxqu(ij)/(1.-sigu(ij)))
    93          
     93
    9494
    9595            ENDDO
    … …  
    100100
    101101            DO ij=ijb+1,ije
    102 #ifdef CRAY
    103                dxq(ij,l)=
    104      ,         cvmgp(dxqu(ij-1)+dxqu(ij),0.,dxqu(ij-1)*dxqu(ij))
    105 #else
    106102               IF(dxqu(ij-1)*dxqu(ij)>0) THEN
    107103                  dxq(ij,l)=dxqu(ij-1)+dxqu(ij)
    … …  
    110106                  dxq(ij,l)=0.
    111107               ENDIF
    112 #endif
    113108               dxq(ij,l)=0.5*dxq(ij,l)
    114109               dxq(ij,l)=
    … …  
    179174             
    180175c   calcul des flux a gauche et a droite
    181 
    182 #ifdef CRAY
    183 c--pas encore modification sur Qsat
    184 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    185       DO l=1,llm
    186        DO ij=ijb,ije-1
    187           zdum(ij,l)=cvmgp(1.-u_m(ij,l)/masse(ij,l,iq),
    188      ,                     1.+u_m(ij,l)/masse(ij+1,l,iq),
    189      ,                     u_m(ij,l))
    190           zdum(ij,l)=0.5*zdum(ij,l)
    191           u_mq(ij,l)=cvmgp(
    192      ,                q(ij,l,iq)+zdum(ij,l)*dxq(ij,l),
    193      ,                q(ij+1,l,iq)-zdum(ij,l)*dxq(ij+1,l),
    194      ,                u_m(ij,l))
    195           u_mq(ij,l)=u_m(ij,l)*u_mq(ij,l)
    196        ENDDO
    197       ENDDO
    198 c$OMP END DO NOWAIT
    199 
    200 #else
    201176c   on cumule le flux correspondant a toutes les mailles dont la masse
    202177c   au travers de la paroi pENDant le pas de temps.
    … …  
    217192      ENDDO
    218193c$OMP END DO NOWAIT
    219 #endif
    220194
    221195
    … …  
    466440      INTEGER ifils,iq2 ! CRisi
    467441
    468       REAL      SSUM
    469 
    470442      DATA first/.true./
    471443      INTEGER ijb,ije
    472444      INTEGER ijbm,ijem
     445
     446      REAL ssum
    473447
    474448      ijb=ij_begin-2*iip1
Note: See TracChangeset for help on using the changeset viewer.