Changeset 4164


Ignore:
Timestamp:
May 26, 2022, 9:19:51 PM (2 years ago)
Author:
oboucher
Message:

add a SAVE argument to variables read in simple aerosol plume model

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/phylmd/mo_simple_plumes.F90

    r4103 r4164  
    3838!$OMP THREADPRIVATE(sp_initialized)
    3939
    40   REAL ::                                      &
     40  REAL, SAVE ::                                &
    4141       plume_lat      (nplumes)               ,& !< latitude of plume center (AOD maximum)
    4242       plume_lon      (nplumes)               ,& !< longitude of plume center (AOD maximum)
    … …  
    5454       theta          (nfeatures,nplumes)     ,& !< Rotation angle of plume feature
    5555       ftr_weight     (nfeatures,nplumes)     ,& !< Feature weights
    56        time_weight    (nfeatures,nplumes)     ,& !< Time weights
    57        time_weight_bg (nfeatures,nplumes)     ,& !< as time_weight but for natural background in Twomey effect
    5856       year_weight    (nyears,nplumes)        ,& !< Yearly weight for plume
    5957       ann_cycle      (nfeatures,ntimes,nplumes) !< annual cycle for plume feature
    … …  
    6159!$OMP THREADPRIVATE(sig_lon_E,sig_lon_W,sig_lat_E,sig_lat_W,theta,ftr_weight,year_weight,ann_cycle)
    6260
     61  REAL ::                                      &
     62       time_weight    (nfeatures,nplumes)     ,& !< Time weights
     63       time_weight_bg (nfeatures,nplumes)        !< as time_weight but for natural background in Twomey effect
     64
    6365  PUBLIC sp_aop_profile
    6466
    … …  
    8082    CHARACTER (len = 50)     :: modname = 'mo_simple_plumes.sp_setup'
    8183    CHARACTER (len = 80)     :: abort_message
    82 
    8384    !
    8485    ! ----------
    … …  
    130131          CALL abort_physic(modname,abort_message,1)
    131132       ENDIF
     133       !
    132134       iret = nf90_inq_varid(ncid, "plume_lon", VarId)
    133135       iret = nf90_get_var(ncid, VarID, plume_lon(:), start=(/1/),count=(/nplumes/))
    … …  
    136138          CALL abort_physic(modname,abort_message,1)
    137139       ENDIF
     140       !
    138141       iret = nf90_inq_varid(ncid, "beta_a"   , VarId)
    139142       iret = nf90_get_var(ncid, VarID, beta_a(:)   , start=(/1/),count=(/nplumes/))
    … …  
    142145          CALL abort_physic(modname,abort_message,1)
    143146       ENDIF
     147       !
    144148       iret = nf90_inq_varid(ncid, "beta_b"   , VarId)
    145149       iret = nf90_get_var(ncid, VarID, beta_b(:)   , start=(/1/),count=(/nplumes/))
    … …  
    148152          CALL abort_physic(modname,abort_message,1)
    149153       ENDIF
     154       !
    150155       iret = nf90_inq_varid(ncid, "aod_spmx" , VarId)
    151156       iret = nf90_get_var(ncid, VarID, aod_spmx(:)  , start=(/1/),count=(/nplumes/))
    … …  
    154159          CALL abort_physic(modname,abort_message,1)
    155160       ENDIF
     161       !
    156162       iret = nf90_inq_varid(ncid, "aod_fmbg" , VarId)
    157163       iret = nf90_get_var(ncid, VarID, aod_fmbg(:)  , start=(/1/),count=(/nplumes/))
    … …  
    160166          CALL abort_physic(modname,abort_message,1)
    161167       ENDIF
     168       !
    162169       iret = nf90_inq_varid(ncid, "ssa550"   , VarId)
    163170       iret = nf90_get_var(ncid, VarID, ssa550(:)  , start=(/1/),count=(/nplumes/))
    … …  
    166173          CALL abort_physic(modname,abort_message,1)
    167174       ENDIF
     175       !
    168176       iret = nf90_inq_varid(ncid, "asy550"   , VarId)
    169177       iret = nf90_get_var(ncid, VarID, asy550(:)  , start=(/1/),count=(/nplumes/))
    … …  
    172180          CALL abort_physic(modname,abort_message,1)
    173181       ENDIF
     182       !
    174183       iret = nf90_inq_varid(ncid, "angstrom" , VarId)
    175184       iret = nf90_get_var(ncid, VarID, angstrom(:), start=(/1/),count=(/nplumes/))
    … …  
    185194          CALL abort_physic(modname,abort_message,1)
    186195       ENDIF
     196       !
    187197       iret = nf90_inq_varid(ncid, "sig_lat_E"     , VarId)
    188198       iret = nf90_get_var(ncid, VarID, sig_lat_E(:,:)    , start=(/1,1/),count=(/nfeatures,nplumes/))
    … …  
    191201          CALL abort_physic(modname,abort_message,1)
    192202       ENDIF
     203       !
    193204       iret = nf90_inq_varid(ncid, "sig_lon_E"     , VarId)
    194205       iret = nf90_get_var(ncid, VarID, sig_lon_E(:,:)    , start=(/1,1/),count=(/nfeatures,nplumes/))
    … …  
    197208          CALL abort_physic(modname,abort_message,1)
    198209       ENDIF
     210       !
    199211       iret = nf90_inq_varid(ncid, "sig_lon_W"     , VarId)
    200212       iret = nf90_get_var(ncid, VarID, sig_lon_W(:,:)    , start=(/1,1/),count=(/nfeatures,nplumes/))
    … …  
    203215          CALL abort_physic(modname,abort_message,1)
    204216       ENDIF
     217       !
    205218       iret = nf90_inq_varid(ncid, "theta"         , VarId)
    206219       iret = nf90_get_var(ncid, VarID, theta(:,:)        , start=(/1,1/),count=(/nfeatures,nplumes/))
    … …  
    209222          CALL abort_physic(modname,abort_message,1)
    210223       ENDIF
     224       !
    211225       iret = nf90_inq_varid(ncid, "ftr_weight"    , VarId)
    212226       iret = nf90_get_var(ncid, VarID, ftr_weight(:,:)   , start=(/1,1/),count=(/nfeatures,nplumes/))
    … …  
    215229          CALL abort_physic(modname,abort_message,1)
    216230       ENDIF
     231       !
    217232       iret = nf90_inq_varid(ncid, "year_weight"   , VarId)
    218233       iret = nf90_get_var(ncid, VarID, year_weight(:,:)  , start=(/1,1/),count=(/nyears,nplumes   /))
    … …  
    221236          CALL abort_physic(modname,abort_message,1)
    222237       ENDIF
     238       !
    223239       iret = nf90_inq_varid(ncid, "ann_cycle"     , VarId)
    224240       iret = nf90_get_var(ncid, VarID, ann_cycle(:,:,:)  , start=(/1,1,1/),count=(/nfeatures,ntimes,nplumes/))
    … …  
    288304      time_weight_bg(1,iplume) = ann_cycle(1,iweek,iplume)
    289305      time_weight_bg(2,iplume) = ann_cycle(2,iweek,iplume)
    290     END DO
     306    ENDDO
    291307   
    292308    RETURN
    … …  
    375391        z_beta(icol,k)   = MERGE(1.0, 0.0, z(icol,k) >= oro(icol))
    376392        eta(icol,k)      = MAX(0.0,MIN(1.0,z(icol,k)/15000.))
    377       END DO
    378     END DO
     393      ENDDO
     394    ENDDO
    379395    DO icol=1,ncol
    380396      dNovrN(icol)   = 1.0
    381397      caod_sp(icol)  = 0.0
    382398      caod_bg(icol)  = 0.02
    383     END DO
     399    ENDDO
    384400    !
    385401    ! sum contribution from plumes to construct composite profiles of aerosol optical properties
    … …  
    391407      DO icol=1,ncol
    392408        beta_sum(icol) = 0.
    393       END DO
     409      ENDDO
    394410      DO k=1,nlevels
    395411        DO icol=1,ncol
    396412          prof(icol,k)   = (eta(icol,k)**(beta_a(iplume)-1.) * (1.-eta(icol,k))**(beta_b(iplume)-1.)) * dz(icol,k)
    397413          beta_sum(icol) = beta_sum(icol) + prof(icol,k)
    398         END DO
    399       END DO
     414        ENDDO
     415      ENDDO
    400416      DO k=1,nlevels
    401417        DO icol=1,ncol
    402418          prof(icol,k)   = ( prof(icol,k) / beta_sum(icol) ) * z_beta(icol,k)
    403         END DO
    404       END DO
     419        ENDDO
     420      ENDDO
    405421      !
    406422      ! calculate plume weights
    … …  
    443459        ssa(icol) = (ssa550(iplume) * lfactor**4) / ((ssa550(iplume) * lfactor**4) + ((1-ssa550(iplume)) * lfactor))
    444460        asy(icol) =  asy550(iplume) * SQRT(lfactor)
    445       END DO
     461      ENDDO
    446462      !
    447463      ! distribute plume optical properties across its vertical profile weighting by optical depth and scaling for
    … …  
    458474          ssa_prof(icol,k) = ssa_prof(icol,k) + aod_lmd * ssa(icol)
    459475          aod_prof(icol,k) = aod_prof(icol,k) + aod_lmd
    460         END DO
    461       END DO
    462     END DO
     476        ENDDO
     477      ENDDO
     478    ENDDO
    463479    !
    464480    ! complete optical depth weighting
    … …  
    468484        asy_prof(icol,k) = MERGE(asy_prof(icol,k)/ssa_prof(icol,k), 0.0, ssa_prof(icol,k) > TINY(1.))
    469485        ssa_prof(icol,k) = MERGE(ssa_prof(icol,k)/aod_prof(icol,k), 1.0, aod_prof(icol,k) > TINY(1.))
    470       END DO
    471     END DO
     486      ENDDO
     487    ENDDO
    472488    !
    473489    ! calculate effective radius normalization (divisor) factor
    … …  
    475491    DO icol=1,ncol
    476492      dNovrN(icol) = LOG((1000.0 * (caod_sp(icol) + caod_bg(icol))) + 1.0)/LOG((1000.0 * caod_bg(icol)) + 1.0)
    477     END DO
     493    ENDDO
    478494
    479495    RETURN
Note: See TracChangeset for help on using the changeset viewer.