Ignore:
Timestamp:
Mar 28, 2013, 1:18:46 PM (12 years ago)
Author:
jleconte
Message:

28/03/2013 == JL

  • optimization of optci and optcv routines. 15to 25% gain on these routines.

around 10% on the whole code with 1 scatterer.

  • No changes on output (byte to byte)
  • corrected bug in gray case in callcorrk.
  • added profiling option in makegcm_ifort. See the file for details
Location:
trunk/LMDZ.GENERIC/libf/phystd
Files:
5 edited

Legend:

Unmodified
Added
Removed

  • trunk/LMDZ.GENERIC/libf/phystd/bilinearbig.F90

    r903 r918  
    1919      label='subroutine bilinear'
    2020
     21
    2122      x=x_in
    2223      y=y_in
    … …  
    2930      if ((x.lt.x_arr(2)).or.(x.gt.x_arr(nX-2))) then
    3031         ind=-1
     32         return
    3133      else
    3234        i=1
    … …  
    7274        end do
    7375      endif
    74 
     76     
    7577      f11=f2d_arr(ind,b)
    7678      f21=f2d_arr(ind+1,b)

  • trunk/LMDZ.GENERIC/libf/phystd/callcorrk.F90

    r861 r918  
    223223         banddir=trim(adjustl(corrkdir))//'/'//trim(adjustl(banddir))
    224224
    225          call sugas_corrk       ! set up gaseous absorption properties
    226225         call setspi            ! basic infrared properties
    227226         call setspv            ! basic visible properties
     227         call sugas_corrk       ! set up gaseous absorption properties
    228228         call suaer_corrk       ! set up aerosol optical properties
    229229

  • trunk/LMDZ.GENERIC/libf/phystd/optci.F90

    r878 r918  
    5757
    5858  real*8 taugsurf(L_NSPECTI,L_NGAUSS-1)
    59   real*8 DCONT
     59  real*8 DCONT,DAERO
    6060  double precision wn_cont, p_cont, p_air, T_cont, dtemp, dtempc
    6161  double precision p_cross
    … …  
    6767
    6868  ! temporary variables for multiple aerosol calculation
    69   real*8 atemp, btemp
     69  real*8 atemp
     70  real*8 btemp(L_NLAYRAD,L_NSPECTI)
    7071
    7172  ! variables for k in units m^-1
    … …  
    132133        LKCOEF(K,LK) = LCOEF(LK)
    133134     end do
    134 
    135 
     135  end do                    ! levels
     136
     137
     138  do iaer=1,naerkind
    136139     DO NW=1,L_NSPECTI
    137         do iaer=1,naerkind
     140        do K=2,L_LEVELS
    138141           TAEROS(K,NW,IAER) = TAUAERO(K,IAER) * QXIAER(K,NW,IAER)
    139         end do
     142        end do                    ! levels
    140143     END DO
    141   end do                    ! levels
    142 
    143   do K=2,L_LEVELS
    144 
    145      do NW=1,L_NSPECTI
    146 
    147         DCONT = 0.0 ! continuum absorption
     144  end do
     145
     146  do NW=1,L_NSPECTI
     147
     148     do K=2,L_LEVELS
     149
     150! continuum absorption
     151        DCONT = 0.0
    148152
    149153        if(continuum.and.(.not.graybody))then
    … …  
    221225        endif
    222226
    223         ! RW 7/3/12: already done above
    224         !if(.not.Continuum)then
    225         !   DCONT=0.0
    226         !endif
    227 
    228         !--- Kasting's CIA ----------------------------------------
    229         !DCO2   = dz(k)*Ci(nw)*(1.2859*PMID(k)/1000.0)*(TMID(k)/300.)**Ti(nw)
    230         !DCO2 = 130*Ci(nw)*(pmid(k)/1013.25)**2*(tmid(k)/300.)**Ti(nw) * dz(k)
    231         ! these two have been verified to give the same results
    232         !----------------------------------------------------------
     227! aerosol absorption
     228        DAERO=SUM(TAEROS(K,NW,1:naerkind))
    233229
    234230        do ng=1,L_NGAUSS-1
    … …  
    273269
    274270           TAUGSURF(NW,NG) = TAUGSURF(NW,NG) + TAUGAS + DCONT
    275            DTAUKI(K,nw,ng) = TAUGAS &
    276                              + DCONT ! For parameterized continuum absorption
    277 
    278            do iaer=1,naerkind
    279               DTAUKI(K,nw,ng) = DTAUKI(K,nw,ng) + TAEROS(K,NW,IAER)
    280            end do ! a bug was here!
     271           DTAUKI(K,nw,ng) = TAUGAS    &
     272                             + DCONT   & ! For parameterized continuum absorption
     273                             + DAERO     ! For aerosol absorption
    281274
    282275        end do
    … …  
    286279
    287280        NG              = L_NGAUSS
    288         DTAUKI(K,nw,ng) = 0.0 + DCONT ! For parameterized continuum absorption
    289 
    290         do iaer=1,naerkind
    291            DTAUKI(K,nw,ng) = DTAUKI(K,nw,ng) +  TAEROS(K,NW,IAER)
    292         end do ! a bug was here!
     281        DTAUKI(K,nw,ng) = 0.d0      &
     282                          + DCONT   & ! For parameterized continuum absorption
     283                          + DAERO     ! For aerosol absorption
    293284
    294285     end do
    … …  
    301292
    302293  do iaer=1,naerkind
    303   DO NW=1,L_NSPECTI
     294    DO NW=1,L_NSPECTI
    304295     DO K=2,L_LEVELS+1
    305296           TAUAEROLK(K,NW,IAER) = TAUAERO(K,IAER)*QSIAER(K,NW,IAER)
    306297     ENDDO
    307   ENDDO
     298    ENDDO
    308299  end do
     300 
     301  DO NW=1,L_NSPECTI
     302     DO L=1,L_NLAYRAD
     303        K              = 2*L+1
     304        btemp(L,NW) = SUM(TAUAEROLK(K,NW,1:naerkind)) + SUM(TAUAEROLK(K+1,NW,1:naerkind))
     305     END DO ! L vertical loop
     306  END DO                    ! NW spectral loop
     307 
    309308
    310309  DO NW=1,L_NSPECTI
    … …  
    316315
    317316        atemp = 0.
    318         btemp = 0.
    319317        if(DTAUI(L,NW,NG) .GT. 1.0E-9) then
    320318           do iaer=1,naerkind
    … …  
    322320                   GIAER(K,NW,IAER)   * TAUAEROLK(K,NW,IAER) +    &
    323321                   GIAER(K+1,NW,IAER) * TAUAEROLK(K+1,NW,IAER)
    324               btemp = btemp + TAUAEROLK(K,NW,IAER) + TAUAEROLK(K+1,NW,IAER)
    325               !     *                    + 1.e-10
    326322           end do
    327            WBARI(L,nw,ng) = btemp  / DTAUI(L,NW,NG)
     323           WBARI(L,nw,ng) = btemp(L,nw)  / DTAUI(L,NW,NG)
    328324        else
    329325           WBARI(L,nw,ng) = 0.0D0
    … …  
    331327        endif
    332328
    333         if(btemp .GT. 0.0) then
    334            cosbi(L,NW,NG) = atemp/btemp
     329        if(btemp(L,nw) .GT. 0.0) then
     330           cosbi(L,NW,NG) = atemp/btemp(L,nw)
    335331        else
    336332           cosbi(L,NW,NG) = 0.0D0
    … …  
    348344              DTAUI(L,nw,ng) = DTAUKI(K,NW,NG)+DTAUKI(K+1,NW,NG)! + 1.e-50
    349345
    350               btemp = 0.
    351346              if(DTAUI(L,NW,NG) .GT. 1.0E-9) then
    352347
    353                  do iaer=1,naerkind
    354                     btemp = btemp + TAUAEROLK(K,NW,IAER) + TAUAEROLK(K+1,NW,IAER)
    355                  end do
    356                  WBARI(L,nw,ng) = btemp  / DTAUI(L,NW,NG)
     348                 WBARI(L,nw,ng) = btemp(L,nw)  / DTAUI(L,NW,NG)
    357349
    358350              else
    … …  
    370362  ! Total extinction optical depths
    371363
    372   DO NW=1,L_NSPECTI       
    373      DO NG=1,L_NGAUSS       ! full gauss loop
    374         TAUI(1,NW,NG)=0.0D0
    375         DO L=1,L_NLAYRAD
    376            TAUI(L+1,NW,NG)=TAUI(L,NW,NG)+DTAUI(L,NW,NG)
    377         END DO
    378 
     364  DO NG=1,L_NGAUSS       ! full gauss loop
     365     DO NW=1,L_NSPECTI       
    379366        TAUCUMI(1,NW,NG)=0.0D0
    380367        DO K=2,L_LEVELS
    … …  
    395382  !enddo
    396383  !close(127)
     384 
     385!  print*,'WBARI'
     386!  print*,WBARI
     387!  print*,'DTAUI'
     388!  print*,DTAUI
     389!  call abort
     390 
    397391
    398392  return

  • trunk/LMDZ.GENERIC/libf/phystd/optcv.F90

    r878 r918  
    6666
    6767  real*8 taugsurf(L_NSPECTV,L_NGAUSS-1)
    68   real*8 DCONT
     68  real*8 DCONT,DAERO
    6969  double precision wn_cont, p_cont, p_air, T_cont, dtemp, dtempc
    7070  double precision p_cross
    … …  
    7676
    7777  ! temporary variables for multiple aerosol calculation
    78   real*8 atemp, btemp, ctemp
     78  real*8 atemp(L_NLAYRAD,L_NSPECTV)
     79  real*8 btemp(L_NLAYRAD,L_NSPECTV)
     80  real*8 ctemp(L_NLAYRAD,L_NSPECTV)
    7981
    8082  ! variables for k in units m^-1
    … …  
    119121        LKCOEF(K,LK) = LCOEF(LK)
    120122     end do
    121 
    122 
    123      DO NW=1,L_NSPECTV
    124         do iaer=1,naerkind
     123  end do                    ! levels
     124
     125
     126  do iaer=1,naerkind
     127     do NW=1,L_NSPECTV
     128        do K=2,L_LEVELS
    125129           TAEROS(K,NW,IAER) = TAUAERO(K,IAER) * QXVAER(K,NW,IAER)
    126         end do
     130        end do                    ! levels
     131     end do
     132  end do
     133  do NW=1,L_NSPECTV
     134     do K=2,L_LEVELS
    127135        TRAY(K,NW)   = TAURAY(NW) * DPR(K)
    128      END DO
    129   end do                    ! levels
    130 
     136     end do                    ! levels
     137  end do
     138 
    131139  !     we ignore K=1...
    132140  do K=2,L_LEVELS
    … …  
    273281
    274282  do iaer=1,naerkind
     283    DO NW=1,L_NSPECTV
     284      DO K=2,L_LEVELS   ! AS: shouldn't this be L_LEVELS+1 ? (see optci)
     285           TAUAEROLK(K,NW,IAER) = TAUAERO(K,IAER) * QSVAER(K,NW,IAER)
     286      ENDDO
     287    ENDDO
     288  end do
     289
    275290  DO NW=1,L_NSPECTV
    276      DO K=2,L_LEVELS   ! AS: shouldn't this be L_LEVELS+1 ? (see optci)
    277            TAUAEROLK(K,NW,IAER) = TAUAERO(K,IAER) * QSVAER(K,NW,IAER)
    278      ENDDO
    279   ENDDO
    280   end do
    281 
    282   DO NW=1,L_NSPECTV
    283     DO NG=1,L_NGAUSS
     291     DO L=1,L_NLAYRAD
     292        K              = 2*L+1
     293        atemp(L,NW) = SUM(GVAER(K,NW,1:naerkind) * TAUAEROLK(K,NW,1:naerkind))+SUM(GVAER(K+1,NW,1:naerkind) * TAUAEROLK(K+1,NW,1:naerkind))
     294        btemp(L,NW) = SUM(TAUAEROLK(K,NW,1:naerkind)) + SUM(TAUAEROLK(K+1,NW,1:naerkind))
     295        ctemp(L,NW) = btemp(L,NW) + 0.9999*(TRAY(K,NW) + TRAY(K+1,NW))
     296        btemp(L,NW) = btemp(L,NW) + TRAY(K,NW) + TRAY(K+1,NW)
     297        COSBV(L,NW,1:L_NGAUSS) = atemp(L,NW)/btemp(L,NW)
     298     END DO ! L vertical loop
     299  END DO                    ! NW spectral loop
     300
     301  DO NG=1,L_NGAUSS
     302    DO NW=1,L_NSPECTV
    284303     DO L=1,L_NLAYRAD-1
    285304
    286305        K              = 2*L+1
    287306        DTAUV(L,nw,ng) = DTAUKV(K,NW,NG) + DTAUKV(K+1,NW,NG)
    288 
    289         atemp = 0.
    290         btemp = TRAY(K,NW) + TRAY(K+1,NW)
    291         ctemp=0.9999*(TRAY(K,NW) + TRAY(K+1,NW))
    292            do iaer=1,naerkind
    293               atemp = atemp +                                     &
    294                    GVAER(K,NW,IAER)   * TAUAEROLK(K,NW,IAER) +    &
    295                    GVAER(K+1,NW,IAER) * TAUAEROLK(K+1,NW,IAER)
    296               btemp = btemp + TAUAEROLK(K,NW,IAER) + TAUAEROLK(K+1,NW,IAER)
    297               ctemp = ctemp + TAUAEROLK(K,NW,IAER) + TAUAEROLK(K+1,NW,IAER)
    298            end do
    299            WBARV(L,nw,ng) = ctemp / DTAUV(L,nw,ng)
    300            COSBV(L,NW,NG) = atemp/btemp
     307        WBARV(L,nw,ng) = ctemp(L,NW) / DTAUV(L,nw,ng)
    301308
    302309      END DO ! L vertical loop
    … …  
    307314        K              = 2*L+1
    308315        DTAUV(L,nw,ng) = DTAUKV(K,NW,NG)
    309 
    310         atemp=0.
    311         btemp=TRAY(K,NW)
    312         ctemp=0.9999*TRAY(K,NW)
    313         do iaer=1,naerkind
    314            atemp = atemp + GVAER(K,NW,IAER) * TAUAEROLK(K,NW,IAER)
    315            btemp = btemp + TAUAEROLK(K,NW,IAER)
    316            ctemp = ctemp + TAUAEROLK(K,NW,IAER)
    317         end do
    318         COSBV(L,NW,NG) = atemp/btemp
    319         WBARV(L,nw,ng) = ctemp/DTAUV(L,nw,ng)
    320 
    321      END DO                 ! NG Gauss loop
    322   END DO                    ! NW spectral loop
     316        WBARV(L,nw,ng) = ctemp(L,NW) / DTAUV(L,nw,ng)
     317     END DO                 ! NW spectral loop
     318  END DO                    ! NG Gauss loop
    323319
    324320  ! Total extinction optical depths
    325321
    326   DO NW=1,L_NSPECTV       
    327      DO NG=1,L_NGAUSS       ! full gauss loop
     322  DO NG=1,L_NGAUSS       ! full gauss loop
     323     DO NW=1,L_NSPECTV       
    328324        TAUV(1,NW,NG)=0.0D0
    329325        DO L=1,L_NLAYRAD
    … …  
    335331           TAUCUMV(K,NW,NG)=TAUCUMV(K-1,NW,NG)+DTAUKV(K,NW,NG)
    336332        END DO
    337      END DO                 ! end full gauss loop
    338   END DO
     333     END DO           
     334  END DO                 ! end full gauss loop
    339335
    340336

  • trunk/LMDZ.GENERIC/libf/phystd/physiq.F90

    r907 r918  
    519519         else
    520520            print*,'WARNING! Thermal conduction in the soil turned off'
    521             capcal(:)=1.e16 !1.e6
     521            capcal(:)=1.e6
    522522            fluxgrd(:)=0.
    523523            if(noradsurf)then
    … …  
    16971697          endif
    16981698          if (corrk) then
    1699 !            call writediagfi(ngrid,"dEzradsw","radiative heating","w.m^-2",3,dEzradsw)
    1700 !            call writediagfi(ngrid,"dEzradlw","radiative heating","w.m^-2",3,dEzradlw)
     1699             call writediagfi(ngrid,"dEzradsw","radiative heating","w.m^-2",3,dEzradsw)
     1700             call writediagfi(ngrid,"dEzradlw","radiative heating","w.m^-2",3,dEzradlw)
    17011701          endif
    17021702          if(watercond) then
    … …  
    17411741
    17421742          if(watercond.or.CLFvarying)then
    1743 !             call writediagfi(ngrid,"rneb_man","H2O cloud fraction (conv)"," ",3,rneb_man)
    1744 !             call writediagfi(ngrid,"rneb_lsc","H2O cloud fraction (large scale)"," ",3,rneb_lsc)
    1745 !             call writediagfi(ngrid,"CLF","H2O cloud fraction"," ",3,cloudfrac)
     1743             call writediagfi(ngrid,"rneb_man","H2O cloud fraction (conv)"," ",3,rneb_man)
     1744             call writediagfi(ngrid,"rneb_lsc","H2O cloud fraction (large scale)"," ",3,rneb_lsc)
     1745             call writediagfi(ngrid,"CLF","H2O cloud fraction"," ",3,cloudfrac)
    17461746             call writediagfi(ngrid,"CLFt","H2O column cloud fraction"," ",2,totcloudfrac)
    17471747          endif
Note: See TracChangeset for help on using the changeset viewer.