Ignore:
Timestamp:
Jul 18, 2017, 4:15:23 PM (7 years ago)
Author:
jvatant
Message:

Adapt various modifs of LMDZ.GENERIC to LMDZ.TITAN from r1690-1694-1699-1709-1715
--JVO

Location:
trunk/LMDZ.TITAN/libf/phytitan
Files:
10 edited

Legend:

Unmodified
Added
Removed

  • trunk/LMDZ.TITAN/libf/phytitan/bilinearbig.F90

    r1526 r1722  
    5656!     ... and for y within the temperature range
    5757      if ((y.lt.y_arr(1)).or.(y.gt.y_arr(nY))) then
    58          write(*,*) 'Warning from bilinearbig routine:'
    59          write(*,*) 'Outside continuum temperature range!'
     58         print*,y_arr(1),y_arr(nY)
     59         !write(*,*) 'Warning from bilinearbig routine:'
     60         !write(*,*) 'Outside continuum temperature range!'
    6061         if(y.lt.y_arr(1))then
    6162            y=y_arr(1)+0.01
     63            b=1
     64            y1=y_arr(b)
     65            y2=y_arr(b+1)
    6266         endif
    6367         if(y.gt.y_arr(nY))then
    6468            y=y_arr(nY)-0.01
     69            b=nY-1
     70            y1=y_arr(b)
     71            y2=y_arr(b+1)
    6572         endif
    6673      else

  • trunk/LMDZ.TITAN/libf/phytitan/callcorrk.F90

    r1648 r1722  
    88          tau_col,firstcall,lastcall)
    99
     10      use mod_phys_lmdz_para, only : is_master
    1011      use radinc_h
    1112      use radcommon_h
    … …  
    1718      USE tracer_h
    1819      use comcstfi_mod, only: pi, mugaz, cpp
    19       use callkeys_mod, only: diurnal,tracer,nosurf,        &
     20      use callkeys_mod, only: diurnal,tracer,        &
    2021                              strictboundcorrk,specOLR
    2122
    … …  
    7576      REAL,INTENT(OUT) :: OSR_nu(ngrid,L_NSPECTV)        ! Outgoing SW radition in each band (Normalized to the band width (W/m2/cm-1).
    7677      REAL,INTENT(OUT) :: tau_col(ngrid)                 ! Diagnostic from aeropacity.
    77       REAL,INTENT(OUT) :: albedo_equivalent(ngrid)       ! Spectrally Integrated Albedo. For Diagnostic. By MT2015 
     78      REAL,INTENT(OUT) :: albedo_equivalent(ngrid)       ! Spectrally Integrated Albedo. For Diagnostic. By MT2015
    7879     
    7980     
    … …  
    113114      REAL*8 taucumi(L_LEVELS,L_NSPECTI,L_NGAUSS)
    114115
    115       REAL*8 tauaero(L_LEVELS+1,naerkind)
     116      REAL*8 tauaero(L_LEVELS,naerkind)
    116117      REAL*8 nfluxtopv,nfluxtopi,nfluxtop,fluxtopvdn
    117118      REAL*8 nfluxoutv_nu(L_NSPECTV)                 ! Outgoing band-resolved VI flux at TOA (W/m2).
    … …  
    167168
    168169        ! test on allocated necessary because of CLFvarying (two calls to callcorrk in physiq)
    169         if(.not.allocated(QXVAER)) allocate(QXVAER(L_LEVELS+1,L_NSPECTV,naerkind))
    170         if(.not.allocated(QSVAER)) allocate(QSVAER(L_LEVELS+1,L_NSPECTV,naerkind))
    171         if(.not.allocated(GVAER)) allocate(GVAER(L_LEVELS+1,L_NSPECTV,naerkind))
    172         if(.not.allocated(QXIAER)) allocate(QXIAER(L_LEVELS+1,L_NSPECTI,naerkind))
    173         if(.not.allocated(QSIAER)) allocate(QSIAER(L_LEVELS+1,L_NSPECTI,naerkind))
    174         if(.not.allocated(GIAER)) allocate(GIAER(L_LEVELS+1,L_NSPECTI,naerkind))
     170        if(.not.allocated(QXVAER)) allocate(QXVAER(L_LEVELS,L_NSPECTV,naerkind))
     171        if(.not.allocated(QSVAER)) allocate(QSVAER(L_LEVELS,L_NSPECTV,naerkind))
     172        if(.not.allocated(GVAER)) allocate(GVAER(L_LEVELS,L_NSPECTV,naerkind))
     173        if(.not.allocated(QXIAER)) allocate(QXIAER(L_LEVELS,L_NSPECTI,naerkind))
     174        if(.not.allocated(QSIAER)) allocate(QSIAER(L_LEVELS,L_NSPECTI,naerkind))
     175        if(.not.allocated(GIAER)) allocate(GIAER(L_LEVELS,L_NSPECTI,naerkind))
    175176
    176177         !!! ALLOCATED instances are necessary because of CLFvarying (strategy to call callcorrk twice in physiq...)
    … …  
    376377            ! Test / Correct for freaky s. s. albedo values.
    377378            do iaer=1,naerkind
    378                do k=1,L_LEVELS+1
     379               do k=1,L_LEVELS
    379380
    380381                  do nw=1,L_NSPECTV
    … …  
    419420            ! boundary conditions
    420421            tauaero(1,iaer)          = tauaero(2,iaer)
    421             tauaero(L_LEVELS+1,iaer) = tauaero(L_LEVELS,iaer)
    422422            !tauaero(1,iaer)          = 0.
    423             !tauaero(L_LEVELS+1,iaer) = 0.
    424423           
    425424         end do ! naerkind
    … …  
    430429            albv(nw)=albedo(ig,nw)
    431430         ENDDO
    432 
    433          if (nosurf) then ! Case with no surface.
    434             DO nw=1,L_NSPECTV
    435                if(albv(nw).gt.0.0) then
    436                   print*,'For open lower boundary in callcorrk must'
    437                   print*,'have spectral surface band albedos all set to zero!'
    438                   call abort
    439                endif
    440             ENDDO         
    441          endif
    442431
    443432      if ((ngrid.eq.1).and.(global1d)) then ! Fixed zenith angle 'szangle' in 1D simulations w/ globally-averaged sunlight.

  • trunk/LMDZ.TITAN/libf/phytitan/callkeys_mod.F90

    r1672 r1722  
    7171      real,save :: MassPlanet
    7272!$OMP THREADPRIVATE(flatten,Rmean,J2,MassPlanet)
     73      real,save :: surfalbedo
     74      real,save :: surfemis
     75!$OMP THREADPRIVATE(surfalbedo,surfemis)
    7376
    7477      logical,save :: iscallphys=.false.!existence of callphys.def

  • trunk/LMDZ.TITAN/libf/phytitan/inifis_mod.F90

    r1672 r1722  
    1010
    1111  use radinc_h, only: ini_radinc_h, naerkind
    12   use radcommon_h, only: ini_radcommon_h
    1312  use datafile_mod, only: datadir
    1413  use comdiurn_h, only: sinlat, coslat, sinlon, coslon
    … …  
    543542  ENDDO
    544543
     544  ! initialize variables in radinc_h
    545545  call ini_radinc_h(nlayer)
    546546 
    547   ! allocate "radcommon_h" arrays
    548   call ini_radcommon_h()
    549 
    550547  ! allocate "comsoil_h" arrays
    551548  call ini_comsoil_h(ngrid)

  • trunk/LMDZ.TITAN/libf/phytitan/optci.F90

    r1648 r1722  
    3232
    3333  real*8 DTAUI(L_NLAYRAD,L_NSPECTI,L_NGAUSS)
    34   real*8 DTAUKI(L_LEVELS+1,L_NSPECTI,L_NGAUSS)
     34  real*8 DTAUKI(L_LEVELS,L_NSPECTI,L_NGAUSS)
    3535  real*8 TAUI(L_NLEVRAD,L_NSPECTI,L_NGAUSS)
    3636  real*8 TAUCUMI(L_LEVELS,L_NSPECTI,L_NGAUSS)
    … …  
    4242
    4343  ! for aerosols
    44   real*8  QXIAER(L_LEVELS+1,L_NSPECTI,NAERKIND)
    45   real*8  QSIAER(L_LEVELS+1,L_NSPECTI,NAERKIND)
    46   real*8  GIAER(L_LEVELS+1,L_NSPECTI,NAERKIND)
    47   real*8  TAUAERO(L_LEVELS+1,NAERKIND)
    48   real*8  TAUAEROLK(L_LEVELS+1,L_NSPECTI,NAERKIND)
     44  real*8  QXIAER(L_LEVELS,L_NSPECTI,NAERKIND)
     45  real*8  QSIAER(L_LEVELS,L_NSPECTI,NAERKIND)
     46  real*8  GIAER(L_LEVELS,L_NSPECTI,NAERKIND)
     47  real*8  TAUAERO(L_LEVELS,NAERKIND)
     48  real*8  TAUAEROLK(L_LEVELS,L_NSPECTI,NAERKIND)
    4949  real*8  TAEROS(L_LEVELS,L_NSPECTI,NAERKIND)
    5050
    … …  
    5252  ! J. Vatant d'Ollone (2016)
    5353  real*8 GWEIGHT(L_NGAUSS)
    54   real*8 DHAZE_T(L_LEVELS+1,L_NSPECTI)
    55   real*8 DHAZES_T(L_LEVELS+1,L_NSPECTI)
    56   real*8 SSA_T(L_LEVELS+1,L_NSPECTI)
    57   real*8 ASF_T(L_LEVELS+1,L_NSPECTI)
     54  real*8 DHAZE_T(L_LEVELS,L_NSPECTI)
     55  real*8 DHAZES_T(L_LEVELS,L_NSPECTI)
     56  real*8 SSA_T(L_LEVELS,L_NSPECTI)
     57  real*8 ASF_T(L_LEVELS,L_NSPECTI)
    5858  real*8 INT_DTAU(L_NLAYRAD,L_NSPECTI)
    5959  real*8 K_HAZE(L_NLAYRAD,L_NSPECTI)
    … …  
    115115  end do                    ! levels
    116116
    117 
     117  ! Spectral dependance of aerosol absorption
    118118  do iaer=1,naerkind
    119119     DO NW=1,L_NSPECTI
    … …  
    127127
    128128     do K=2,L_LEVELS
    129 
     129     
    130130        ilay = k / 2 ! int. arithmetic => gives the gcm layer index
    131131       
    132 ! continuum absorption
    133         DCONT = 0.0d0
     132        DAERO=SUM(TAEROS(K,NW,1:naerkind)) ! aerosol absorption
     133
     134        !================= Titan customisation ========================================
     135        call disr_haze(dz(k),plev(k),wnoi(nw),dhaze_T(k,nw),SSA_T(k,nw),ASF_T(k,nw))
     136        ! =============================================================================
     137
     138        DCONT = 0.0d0 ! continuum absorption
    134139
    135140        if(continuum.and.(.not.graybody))then
    … …  
    207212        endif
    208213
    209 ! aerosol absorption
    210         DAERO=SUM(TAEROS(K,NW,1:naerkind))
    211 
    212 !================= Titan customisation ========================================
    213         call disr_haze(dz(k),plev(k),wnoi(nw),dhaze_T(k,nw),SSA_T(k,nw),ASF_T(k,nw))
    214 ! =============================================================================
    215 
    216 
    217214        do ng=1,L_NGAUSS-1
    218215
    … …  
    251248  end do
    252249
    253   DTAUKI(L_LEVELS+1,1:L_NSPECTI,1:L_NGAUSS)=0.d0
    254  
    255  
    256250  !=======================================================================
    257251  !     Now the full treatment for the layers, where besides the opacity
    … …  
    261255  do iaer=1,naerkind
    262256    DO NW=1,L_NSPECTI
    263      DO K=2,L_LEVELS+1
    264            TAUAEROLK(K,NW,IAER) = TAUAERO(K,IAER)*QSIAER(K,NW,IAER)
     257     DO K=2,L_LEVELS
     258           TAUAEROLK(K,NW,IAER) = TAUAERO(K,IAER)*QSIAER(K,NW,IAER) ! effect of scattering albedo
    265259     ENDDO
    266260    ENDDO
    … …  
    269263  ! Haze scattering
    270264  DO NW=1,L_NSPECTI
    271     DO K=2,L_LEVELS+1
     265    DO K=2,L_LEVELS
    272266      DHAZES_T(K,NW) = DHAZE_T(K,NW) * SSA_T(K,NW)
    273267    ENDDO
    … …  
    281275     END DO ! L vertical loop
    282276     
    283      !last level
    284      L              = L_NLAYRAD
    285      K              = 2*L+1
    286      
     277     ! Last level
     278     L           = L_NLAYRAD
     279     K           = 2*L+1
    287280     btemp(L,NW) = SUM(TAUAEROLK(K,NW,1:naerkind)) + DHAZES_T(K,NW)
    288281     
    289282  END DO                    ! NW spectral loop
    290283 
    291 ! ======================================================================
    292284
    293285  DO NW=1,L_NSPECTI
    … …  
    296288
    297289        K              = 2*L+1
    298 
    299290        DTAUI(L,nw,ng) = DTAUKI(K,NW,NG) + DTAUKI(K+1,NW,NG)! + 1.e-50
    300291
    … …  
    306297                   GIAER(K+1,NW,IAER) * TAUAEROLK(K+1,NW,IAER)
    307298           end do
    308            atemp = atemp + ASF_T(K,NW)*DHAZES_T(K,NW)
     299           atemp = atemp +                   &
     300                ASF_T(K,NW)*DHAZES_T(K,NW) + &
     301                ASF_T(K+1,NW)*DHAZES_T(K+1,NW)
     302
    309303           WBARI(L,nw,ng) = btemp(L,nw)  / DTAUI(L,NW,NG)
    310304        else
    … …  
    321315     END DO ! L vertical loop
    322316     
    323      !     No vertical averaging on bottom layer
    324 
    325      L = L_NLAYRAD
    326      K = 2*L+1
    327      DTAUI(L,nw,ng) = DTAUKI(K,NW,NG)
     317     ! Last level
    328318     
    329         atemp = 0.
    330         if(DTAUI(L,NW,NG) .GT. 1.0D-9) then
    331            do iaer=1,naerkind
    332               atemp = atemp +                                     &
    333                    GIAER(K,NW,IAER)   * TAUAEROLK(K,NW,IAER)
    334            end do
    335            atemp = atemp + ASF_T(K,NW)*DHAZES_T(K,NW)
    336            WBARI(L,nw,ng) = btemp(L,nw)  / DTAUI(L,NW,NG)
    337         else
    338            WBARI(L,nw,ng) = 0.0D0
    339            DTAUI(L,NW,NG) = 1.0D-9
    340         endif
    341 
    342         if(btemp(L,nw) .GT. 0.0d0) then
    343            cosbi(L,NW,NG) = atemp/btemp(L,nw)
    344         else
    345            cosbi(L,NW,NG) = 0.0D0
    346         end if
     319     L              = L_NLAYRAD
     320     K              = 2*L+1
     321     DTAUI(L,nw,ng) = DTAUKI(K,NW,NG) ! + 1.e-50
     322
     323     atemp = 0.
     324     if(DTAUI(L,NW,NG) .GT. 1.0D-9) then
     325        do iaer=1,naerkind
     326           atemp = atemp + GIAER(K,NW,IAER)   * TAUAEROLK(K,NW,IAER)
     327        end do
     328        atemp = atemp + ASF_T(K,NW)*DHAZES_T(K,NW)
     329        WBARI(L,nw,ng) = btemp(L,nw)  / DTAUI(L,NW,NG)
     330     else
     331        WBARI(L,nw,ng) = 0.0D0
     332        DTAUI(L,NW,NG) = 1.0D-9
     333     endif
     334
     335     if(btemp(L,nw) .GT. 0.0d0) then
     336        cosbi(L,NW,NG) = atemp/btemp(L,nw)
     337     else
     338        cosbi(L,NW,NG) = 0.0D0
     339     end if
     340
    347341
    348342     ! Now the other Gauss points, if needed.
    349343
    350344     DO NG=1,L_NGAUSS-1
    351      
    352345        IF(TAUGSURF(NW,NG) .gt. TLIMIT) THEN
    353346
    … …  
    357350
    358351              if(DTAUI(L,NW,NG) .GT. 1.0D-9) then
    359                 WBARI(L,nw,ng) = btemp(L,nw)  / DTAUI(L,NW,NG)
     352
     353                 WBARI(L,nw,ng) = btemp(L,nw)  / DTAUI(L,NW,NG)
     354
    360355              else
    361356                 WBARI(L,nw,ng) = 0.0D0
    … …  
    366361           END DO ! L vertical loop
    367362           
    368             !     No vertical averaging on bottom layer
    369 
    370             L = L_NLAYRAD
    371             K = 2*L+1
    372             DTAUI(L,nw,ng) = DTAUKI(K,NW,NG)
    373             if(DTAUI(L,NW,NG) .GT. 1.0D-9) then
     363           ! Last level
     364           L              = L_NLAYRAD
     365           K              = 2*L+1
     366           DTAUI(L,nw,ng) = DTAUKI(K,NW,NG)! + 1.e-50
     367
     368           if(DTAUI(L,NW,NG) .GT. 1.0D-9) then
     369
    374370              WBARI(L,nw,ng) = btemp(L,nw)  / DTAUI(L,NW,NG)
    375             else
    376                WBARI(L,nw,ng) = 0.0D0
    377                DTAUI(L,NW,NG) = 1.0D-9
    378             endif
    379             cosbi(L,NW,NG) = cosbi(L,NW,L_NGAUSS)
     371
     372           else
     373              WBARI(L,nw,ng) = 0.0D0
     374              DTAUI(L,NW,NG) = 1.0D-9
     375           endif
     376
     377           cosbi(L,NW,NG) = cosbi(L,NW,L_NGAUSS)
    380378           
    381379        END IF

  • trunk/LMDZ.TITAN/libf/phytitan/optcv.F90

    r1648 r1722  
    2424  !     
    2525  !     THIS SUBROUTINE SETS THE OPTICAL CONSTANTS IN THE VISUAL 
    26   !     IT CALCUALTES FOR EACH LAYER, FOR EACH SPECRAL INTERVAL IN THE VISUAL
     26  !     IT CALCULATES FOR EACH LAYER, FOR EACH SPECTRAL INTERVAL IN THE VISUAL
    2727  !     LAYER: WBAR, DTAU, COSBAR
    2828  !     LEVEL: TAU
    … …  
    3939
    4040  real*8 DTAUV(L_NLAYRAD,L_NSPECTV,L_NGAUSS)
    41   real*8 DTAUKV(L_LEVELS+1,L_NSPECTV,L_NGAUSS)
     41  real*8 DTAUKV(L_LEVELS,L_NSPECTV,L_NGAUSS)
    4242  real*8 TAUV(L_NLEVRAD,L_NSPECTV,L_NGAUSS)
    4343  real*8 TAUCUMV(L_LEVELS,L_NSPECTV,L_NGAUSS)
    … …  
    4848
    4949  ! for aerosols
    50   real*8  QXVAER(L_LEVELS+1,L_NSPECTV,NAERKIND)
    51   real*8  QSVAER(L_LEVELS+1,L_NSPECTV,NAERKIND)
    52   real*8  GVAER(L_LEVELS+1,L_NSPECTV,NAERKIND)
    53   real*8  TAUAERO(L_LEVELS+1,NAERKIND)
    54   real*8  TAUAEROLK(L_LEVELS+1,L_NSPECTV,NAERKIND)
     50  real*8  QXVAER(L_LEVELS,L_NSPECTV,NAERKIND)
     51  real*8  QSVAER(L_LEVELS,L_NSPECTV,NAERKIND)
     52  real*8  GVAER(L_LEVELS,L_NSPECTV,NAERKIND)
     53  real*8  TAUAERO(L_LEVELS,NAERKIND)
     54  real*8  TAUAEROLK(L_LEVELS,L_NSPECTV,NAERKIND)
    5555  real*8  TAEROS(L_LEVELS,L_NSPECTV,NAERKIND)
    5656
    … …  
    5858  ! J. Vatant d'Ollone (2016)
    5959  real*8 GWEIGHT(L_NGAUSS)
    60   real*8 DHAZE_T(L_LEVELS+1,L_NSPECTI)
    61   real*8 DHAZES_T(L_LEVELS+1,L_NSPECTI)
    62   real*8 SSA_T(L_LEVELS+1,L_NSPECTI)
    63   real*8 ASF_T(L_LEVELS+1,L_NSPECTI)
     60  real*8 DHAZE_T(L_LEVELS,L_NSPECTI)
     61  real*8 DHAZES_T(L_LEVELS,L_NSPECTI)
     62  real*8 SSA_T(L_LEVELS,L_NSPECTI)
     63  real*8 ASF_T(L_LEVELS,L_NSPECTI)
    6464  real*8 INT_DTAU(L_NLAYRAD,L_NSPECTI)
    6565  real*8 K_HAZE(L_NLAYRAD,L_NSPECTI)
    … …  
    7373  real*8  TAURAY(L_NSPECTV)
    7474  real*8  TRAY(L_LEVELS,L_NSPECTV)
    75   real*8  TRAYAER
    7675  real*8  DPR(L_LEVELS), U(L_LEVELS)
    7776  real*8  LCOEF(4), LKCOEF(L_LEVELS,4)
    … …  
    7978  real*8 taugsurf(L_NSPECTV,L_NGAUSS-1)
    8079  real*8 DCONT,DAERO
     80  real*8 DRAYAER
    8181  double precision wn_cont, p_cont, p_air, T_cont, dtemp, dtempc
    8282  double precision p_cross
    … …  
    127127  end do                    ! levels
    128128
    129 
     129  ! Spectral dependance of aerosol absorption
    130130  do iaer=1,naerkind
    131131     do NW=1,L_NSPECTV
    … …  
    135135     end do
    136136  end do
     137 
     138  ! Rayleigh scattering
    137139  do NW=1,L_NSPECTV
    138140     do K=2,L_LEVELS
    … …  
    140142     end do                    ! levels
    141143  end do
    142 
     144 
    143145  !     we ignore K=1...
    144146  do K=2,L_LEVELS
    … …  
    148150     do NW=1,L_NSPECTV
    149151
    150         TRAYAER = TRAY(K,NW)
    151         !     TRAYAER is Tau RAYleigh scattering, plus AERosol opacity
     152        !================= Titan customisation ========================================
     153        call disr_haze(dz(k),plev(k),wnov(nw),dhaze_T(k,nw),SSA_T(k,nw),ASF_T(k,nw))
     154        ! =============================================================================
     155
     156        DRAYAER = TRAY(K,NW)
     157        !     DRAYAER is Tau RAYleigh scattering, plus AERosol opacity
    152158        do iaer=1,naerkind
    153            TRAYAER = TRAYAER + TAEROS(K,NW,IAER)
     159           DRAYAER = DRAYAER + TAEROS(K,NW,IAER)
    154160        end do
     161
     162        DRAYAER = DRAYAER + DHAZE_T(K,NW) ! Titan's aerosol
    155163
    156164        DCONT = 0.0 ! continuum absorption
    … …  
    221229        endif
    222230
    223 !================= Titan customisation ========================================
    224         call disr_haze(dz(k),plev(k),wnov(nw),dhaze_T(k,nw),SSA_T(k,nw),ASF_T(k,nw))
    225 ! =============================================================================
    226 
    227231        do ng=1,L_NGAUSS-1
    228232
    … …  
    239243                LKCOEF(K,3)*KCOEF(3) + LKCOEF(K,4)*KCOEF(4)
    240244
     245
    241246           TAUGAS  = U(k)*ANS
    242247
    243248           TAUGSURF(NW,NG) = TAUGSURF(NW,NG) + TAUGAS + DCONT
    244249           DTAUKV(K,nw,ng) = TAUGAS &
    245                              + TRAYAER & ! TRAYAER includes all scattering contributions
    246                              + DCONT    & ! For parameterized continuum aborption
    247                              + DHAZE_T(K,NW)  ! For Titan haze
     250                             + DRAYAER & ! DRAYAER includes all scattering contributions
     251                             + DCONT ! For parameterized continuum aborption
    248252
    249253        end do
    … …  
    253257
    254258        NG              = L_NGAUSS
    255         DTAUKV(K,nw,ng) = TRAY(K,NW) + DCONT  & ! For parameterized continuum absorption
    256                               + DHAZE_T(K,NW)  ! For Titan haze
    257 
    258         do iaer=1,naerkind
    259            DTAUKV(K,nw,ng) = DTAUKV(K,nw,ng) +  TAEROS(K,NW,IAER)
    260         end do ! a bug was here!
     259        DTAUKV(K,nw,ng) = DRAYAER + DCONT ! Scattering + parameterized continuum absorption, including Titan's haze
    261260
    262261     end do
    … …  
    267266  !     Now the full treatment for the layers, where besides the opacity
    268267  !     we need to calculate the scattering albedo and asymmetry factors
    269   ! ======================================================================
    270  
     268
    271269  do iaer=1,naerkind
    272270    DO NW=1,L_NSPECTV
    273       DO K=2,L_LEVELS   ! AS: shouldn't this be L_LEVELS+1 ? (see optci)
    274            TAUAEROLK(K,NW,IAER) = TAUAERO(K,IAER) * QSVAER(K,NW,IAER)
     271      DO K=2,L_LEVELS
     272           TAUAEROLK(K,NW,IAER) = TAUAERO(K,IAER) * QSVAER(K,NW,IAER) ! effect of scattering albedo
    275273      ENDDO
    276274    ENDDO
    … …  
    279277  ! Haze scattering
    280278  DO NW=1,L_NSPECTV
    281     DO K=2,L_LEVELS+1
    282       DHAZES_T(K,NW) = DHAZE_T(K,NW) * SSA_T(K,NW)
     279    DO K=2,L_LEVELS
     280      DHAZES_T(K,NW) = DHAZE_T(K,NW) * SSA_T(K,NW) ! effect of scattering albedo on haze
    283281    ENDDO
    284282  ENDDO
    … …  
    288286     DO L=1,L_NLAYRAD-1
    289287        K              = 2*L+1
    290        
    291         atemp(L,NW) = SUM(GVAER(K,NW,1:naerkind) * TAUAEROLK(K,NW,1:naerkind)) &
    292                     + SUM(GVAER(K+1,NW,1:naerkind) * TAUAEROLK(K+1,NW,1:naerkind)) &
    293                     + ASF_T(K,NW)*DHAZES_T(K,NW)
    294                    
     288        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)) &
     289                    + ASF_T(K,NW)*DHAZES_T(K,NW) + ASF_T(K+1,NW)*DHAZES_T(K+1,NW)
    295290        btemp(L,NW) = SUM(TAUAEROLK(K,NW,1:naerkind)) + SUM(TAUAEROLK(K+1,NW,1:naerkind)) &
    296                     + DHAZES_T(K,NW)
    297        
    298         ctemp(L,NW) = btemp(L,NW) + 0.9999*(TRAY(K,NW) + TRAY(K+1,NW))
     291                    + DHAZES_T(K,NW) + DHAZES_T(K+1,NW)
     292        ctemp(L,NW) = btemp(L,NW) + 0.9999*(TRAY(K,NW) + TRAY(K+1,NW)) ! JVO 2017 : does this 0.999 is really meaningful ?
    299293        btemp(L,NW) = btemp(L,NW) + TRAY(K,NW) + TRAY(K+1,NW)
    300294        COSBV(L,NW,1:L_NGAUSS) = atemp(L,NW)/btemp(L,NW)
    301295     END DO ! L vertical loop
    302296     
    303      !last level
    304      L              = L_NLAYRAD
    305      K              = 2*L+1
    306      
     297     ! Last level
     298     L           = L_NLAYRAD
     299     K           = 2*L+1
    307300     atemp(L,NW) = SUM(GVAER(K,NW,1:naerkind) * TAUAEROLK(K,NW,1:naerkind)) &
    308301                 + ASF_T(K,NW)*DHAZES_T(K,NW)
    309302     btemp(L,NW) = SUM(TAUAEROLK(K,NW,1:naerkind)) &
    310303                 + DHAZES_T(K,NW)
    311      ctemp(L,NW) = btemp(L,NW) + 0.9999*TRAY(K,NW)
     304     ctemp(L,NW) = btemp(L,NW) + 0.9999*TRAY(K,NW) ! JVO 2017 : does this 0.999 is really meaningful ?
    312305     btemp(L,NW) = btemp(L,NW) + TRAY(K,NW)
    313306     COSBV(L,NW,1:L_NGAUSS) = atemp(L,NW)/btemp(L,NW)
    … …  
    316309  END DO                    ! NW spectral loop
    317310
    318 ! ===========================================================================================
    319 
    320311  DO NG=1,L_NGAUSS
    321312    DO NW=1,L_NSPECTV
    … …  
    328319      END DO ! L vertical loop
    329320
    330         !     No vertical averaging on bottom layer
     321        ! Last level
    331322
    332323        L              = L_NLAYRAD
    … …  
    356347
    357348
    358 !  Titan's outputs (J.V.O, 2016)===============================================
     349!  Titan's outputs (JVO, 2016)===============================================
    359350!      do l=1,L_NLAYRAD
    360351!         do nw=1,L_NSPECTV

  • trunk/LMDZ.TITAN/libf/phytitan/phyetat0_mod.F90

    r1670 r1722  
    1010                     emis,q2,qsurf)
    1111
     12! to use  'getin_p'
     13      use ioipsl_getin_p_mod, only: getin_p
    1214
    1315  use tabfi_mod, only: tabfi
    … …  
    1719                     get_field, get_var, inquire_field, &
    1820                     inquire_dimension, inquire_dimension_length
     21  use callkeys_mod, only: surfalbedo,surfemis
    1922
    2023  implicit none
    … …  
    106109  endif
    107110else
    108   phisfi(:)=0
     111  phisfi(:)=0.
    109112endif ! of if (startphy_file)
    110113write(*,*) "phyetat0: surface geopotential <phisfi> range:", &
    … …  
    118121  endif
    119122else
    120   albedodat(:)=0.5 ! would be better to read value from def file...
     123  ! If no startfi file, use parameter surfalbedo in def file
     124  surfalbedo=0.5
     125  call getin_p("surfalbedo",surfalbedo)
     126  print*,"surfalbedo",surfalbedo
     127  albedodat(:)=surfalbedo
    121128endif ! of if (startphy_file)
    122129write(*,*) "phyetat0: Bare ground albedo <albedodat> range:", &
    … …  
    130137  endif
    131138else
    132   zmea(:)=0
     139  zmea(:)=0.
    133140endif ! of if (startphy_file)
    134141write(*,*) "phyetat0: <ZMEA> range:", &
    … …  
    142149  endif
    143150else
    144   zstd(:)=0
     151  zstd(:)=0.
    145152endif ! of if (startphy_file)
    146153write(*,*) "phyetat0: <ZSTD> range:", &
    … …  
    154161  endif
    155162else
    156   zsig(:)=0
     163  zsig(:)=0.
    157164endif ! of if (startphy_file)
    158165write(*,*) "phyetat0: <ZSIG> range:", &
    … …  
    166173  endif
    167174else
    168   zgam(:)=0
     175  zgam(:)=0.
    169176endif ! of if (startphy_file)
    170177write(*,*) "phyetat0: <ZGAM> range:", &
    … …  
    178185  endif
    179186else
    180   zthe(:)=0
     187  zthe(:)=0.
    181188endif ! of if (startphy_file)
    182189write(*,*) "phyetat0: <ZTHE> range:", &
    … …  
    190197  endif
    191198else
    192   tsurf(:)=0 ! will be updated afterwards in physiq !
     199  tsurf(:)=0. ! will be updated afterwards in physiq !
    193200endif ! of if (startphy_file)
    194201write(*,*) "phyetat0: Surface temperature <tsurf> range:", &
    … …  
    202209  endif
    203210else
    204   emis(:)=1 ! would be better to read value from def file...
     211  ! If no startfi file, use parameter surfemis in def file
     212  surfemis=1.0
     213  call getin_p("surfemis",surfemis)
     214  print*,"surfemis",surfemis
     215  emis(:)=surfemis
    205216endif ! of if (startphy_file)
    206217write(*,*) "phyetat0: Surface emissivity <emis> range:", &
    … …  
    214225  endif
    215226else
    216   q2(:,:)=0
     227  q2(:,:)=0.
    217228endif ! of if (startphy_file)
    218229write(*,*) "phyetat0: PBL wind variance <q2> range:", &
    … …  
    231242      endif
    232243    else
    233       qsurf(:,iq)=0
     244      qsurf(:,iq)=0.
    234245    endif ! of if (startphy_file)
    235246    write(*,*) "phyetat0: Surface tracer <",trim(txt),"> range:", &

  • trunk/LMDZ.TITAN/libf/phytitan/physiq_mod.F90

    r1672 r1722  
    11861186      if(callsoil)then
    11871187         TsS = SUM(cell_area(:)*tsoil(:,nsoilmx))/totarea        ! mean temperature at bottom soil layer
    1188          print*,'  ave[Tsurf]     min[Tsurf]     max[Tsurf]     ave[Tdeep]'
    1189          print*,Ts1,Ts2,Ts3,TsS
     1188         if (is_master) then
     1189            print*,'          ave[Tsurf]             min[Tsurf]             max[Tsurf]             ave[Tdeep]'
     1190            print*,Ts1,Ts2,Ts3,TsS
     1191         end if
    11901192      else
    1191                if (is_master) then
    1192             print*,'  ave[Tsurf]     min[Tsurf]     max[Tsurf]'
     1193         if (is_master) then
     1194            print*,'          ave[Tsurf]             min[Tsurf]             max[Tsurf]'
    11931195            print*,Ts1,Ts2,Ts3
    11941196         endif
    … …  
    12791281
    12801282
    1281       print*,'--> Ls =',zls*180./pi
     1283      if (is_master) print*,'--> Ls =',zls*180./pi
    12821284     
    12831285     

  • trunk/LMDZ.TITAN/libf/phytitan/radcommon_h.F90

    r1648 r1722  
    77!
    88!                             radcommon.h
    9 !v
     9!
    1010!----------------------------------------------------------------------C
    1111!
    … …  
    130130      real*8,save :: gweight(L_NGAUSS)
    131131!$OMP THREADPRIVATE(QREFvis,QREFir,omegaREFvis,omegaREFir,&     ! gweight read by master in sugas_corrk
    132                 !$OMP tstellar,planckir,PTOP,TAUREF)
     132                !$OMP tstellar,planckir,PTOP)
    133133
    134134!     If the gas optical depth (top to the surface) is less than
    … …  
    154154!$OMP THREADPRIVATE(glat,eclipse)
    155155
    156 contains
    157 
    158       subroutine ini_radcommon_h
    159       use radinc_h, only: L_LEVELS
    160       implicit none
    161      
    162         allocate(TAUREF(L_LEVELS+1))
    163      
    164       end subroutine ini_radcommon_h
    165 
    166156end module radcommon_h

  • trunk/LMDZ.TITAN/libf/phytitan/wstats.F90

    r1565 r1722  
    219219      start=(/1,1,indx,0/)
    220220      if (klon_glo>1) then !general case
    221         sizes=(/nbp_lon+1,nbp_lev,1,0/)
     221        sizes=(/nbp_lon+1,nbp_lat,1,0/)
    222222      else
    223223        sizes=(/1,1,1,0/)
Note: See TracChangeset for help on using the changeset viewer.