Ignore:
Timestamp:
Mar 4, 2004, 4:11:16 PM (20 years ago)
Author:
lmdzadmin
Message:

Optimisation de differentes routines, IM, MAF, FH
LF

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/orografi.F

    r493 r495  
    315315      call gwprofil
    316316     *       (  nlon , nlev
    317      *       , kgwd   , kdx
     317     *       , kgwd   , kdx , ktest
    318318     *       , ikcrith, icrit
    319319     *       , paphm1, zrho   , zstab ,  zvph
    … …  
    343343c
    344344c
    345       do 523 jl=1,kgwd
    346       ji=kdx(jl)
     345c     do 523 jl=1,kgwd
     346c     ji=kdx(jl)
     347c  Modif vectorisation 02/04/2004
     348      do 523 ji=kidia,kfdia
     349      if(ktest(ji).eq.1) then
     350
    347351      zdelp=paphm1(ji,jk+1)-paphm1(ji,jk)
    348352      ztemp=-rg*(ztau(ji,jk+1)-ztau(ji,jk))/(zvph(ji,ilevp1)*zdelp)
    … …  
    401405      pte(ji,jk)=0.0
    402406
     407      endif
    403408  523 continue
    404409
    … …  
    10071012      SUBROUTINE GWPROFIL
    10081013     *         ( NLON, NLEV
    1009      *         , kgwd, kdx
     1014     *         , kgwd, kdx , ktest
    10101015     *         , KKCRITH, KCRIT
    10111016     *         , PAPHM1, PRHO   , PSTAB  , PVPH , PRI , PTAU
    … …  
    10751080      integer nlon,nlev
    10761081      INTEGER KKCRITH(NLON),KCRIT(NLON)
    1077      *       ,kdx(nlon)
     1082     *       ,kdx(nlon) , ktest(nlon)
     1083
    10781084C
    10791085      REAL PAPHM1(NLON,NLEV+1), PSTAB(NLON,NLEV+1),
    … …  
    11091115      ilevh=KLEV/3
    11101116C
    1111       DO 400 ji=1,kgwd
    1112       jl=kdx(ji)
     1117c     DO 400 ji=1,kgwd
     1118c     jl=kdx(ji)
     1119c  Modif vectorisation 02/04/2004
     1120      DO 400 jl=kidia,kfdia
     1121      if (ktest(jl).eq.1) then
    11131122      Zoro(JL)=Psig(JL)*Pdmod(JL)/4./max(pvar(jl),1.0)
    11141123      ZTAU(JL,KLEV+1)=PTAU(JL,KLEV+1)
     1124      endif
    11151125  400 CONTINUE
    11161126 
    … …  
    11231133  410 CONTINUE
    11241134C
    1125       DO 411 ji=1,kgwd
    1126       jl=kdx(ji)
     1135c     DO 411 ji=1,kgwd
     1136c     jl=kdx(ji)
     1137c  Modif vectorisation 02/04/2004
     1138      do 411 jl=kidia,kfdia
     1139      if (ktest(jl).eq.1) then
    11271140           IF(JK.GT.KKCRITH(JL)) THEN
    11281141           PTAU(JL,JK)=ZTAU(JL,KLEV+1)
    … …  
    11321145           PTAU(JL,JK)=GRAHILO*ZTAU(JL,KLEV+1)
    11331146           ENDIF
     1147      endif
    11341148 411  CONTINUE             
    11351149C
    … …  
    11431157  420 CONTINUE
    11441158C
    1145       DO 421 ji=1,kgwd
    1146       jl=kdx(ji)
     1159c     DO 421 ji=1,kgwd
     1160c     jl=kdx(ji)
     1161c  Modif vectorisation 02/04/2004
     1162      do 421 jl=kidia,kfdia
     1163      if(ktest(jl).eq.1) then
    11471164      IF(JK.LT.KKCRITH(JL)) THEN
    11481165      ZNORM(JL)=gkdrag*PRHO(JL,JK)*SQRT(PSTAB(JL,JK))*PVPH(JL,JK)
    … …  
    11501167      ZDZ2(JL,JK)=PTAU(JL,JK+1)/max(ZNORM(JL),gssec)
    11511168      ENDIF
     1169      endif
    11521170  421 CONTINUE
    11531171C
    … …  
    11571175C
    11581176                         
    1159       DO 431 ji=1,kgwd
    1160       jl=kdx(ji)
     1177c     DO 431 ji=1,kgwd
     1178c     jl=Kdx(ji)
     1179c  Modif vectorisation 02/04/2004
     1180      do 431 jl=kidia,kfdia
     1181      if(ktest(jl).eq.1) then
     1182
    11611183          IF(JK.LT.KKCRITH(JL)) THEN
    11621184          IF((PTAU(JL,JK+1).LT.GTSEC).OR.(JK.LE.KCRIT(JL))) THEN
    … …  
    11781200          ENDIF
    11791201          ENDIF
     1202      endif
    11801203  431 CONTINUE
    11811204 
    … …  
    11851208C  REORGANISATION OF THE STRESS PROFILE AT LOW LEVEL
    11861209
    1187       DO 530 ji=1,kgwd
    1188       jl=kdx(ji)
     1210c     DO 530 ji=1,kgwd
     1211c     jl=kdx(ji)
     1212c  Modif vectorisation 02/04/2004
     1213      do 530 jl=kidia,kfdia
     1214      if(ktest(jl).eq.1) then
    11891215      ZTAU(JL,KKCRITH(JL))=PTAU(JL,KKCRITH(JL))
    11901216      ZTAU(JL,NSTRA)=PTAU(JL,NSTRA)
     1217      endif
    11911218 530  CONTINUE     
    11921219
    11931220      DO 531 JK=1,KLEV
    11941221     
    1195       DO 532 ji=1,kgwd
    1196       jl=kdx(ji)
     1222c     DO 532 ji=1,kgwd
     1223c     jl=kdx(ji)
     1224c  Modif vectorisation 02/04/2004
     1225      do 532 jl=kidia,kfdia
     1226      if(ktest(jl).eq.1) then
     1227
    11971228               
    11981229         IF(JK.GT.KKCRITH(JL))THEN
    … …  
    12061237        ENDIF
    12071238           
     1239      endif
    12081240 532  CONTINUE   
    12091241 
    12101242C  REORGANISATION IN THE STRATOSPHERE
    12111243
    1212       DO 533 ji=1,kgwd
    1213       jl=kdx(ji)
     1244c     DO 533 ji=1,kgwd
     1245c     jl=kdx(ji)
     1246c  Modif vectorisation 02/04/2004
     1247      do 533 jl=kidia,kfdia
     1248      if(ktest(jl).eq.1) then
     1249
    12141250
    12151251         IF(JK.LT.NSTRA)THEN
    … …  
    12211257        ENDIF
    12221258
     1259      endif
    12231260 533  CONTINUE
    12241261
    12251262C REORGANISATION IN THE TROPOSPHERE
    12261263
    1227        DO 534 ji=1,kgwd
    1228        jl=kdx(ji)
     1264c      DO 534 ji=1,kgwd
     1265c      jl=kdx(ji)
     1266c  Modif vectorisation 02/04/2004
     1267      do 534 jl=kidia,kfdia
     1268      if(ktest(jl).eq.1) then
     1269
    12291270
    12301271         IF(JK.LT.KKCRITH(JL).AND.JK.GT.NSTRA)THEN
    … …  
    12361277
    12371278       ENDIF
     1279      endif
    12381280 534   CONTINUE
    12391281
Note: See TracChangeset for help on using the changeset viewer.