Ignore:
Timestamp:
Apr 14, 2017, 4:42:31 PM (8 years ago)
Author:
oboucher
Message:

Introducing dry AOD diagnostics for the total aerosols and specieswise
The calculations are only performed if the diagnostics are requested

Location:
LMDZ5/trunk/libf/phylmd
Files:
9 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/trunk/libf/phylmd/iophy.F90

    r2660 r2854  
    4545
    4646  SUBROUTINE init_iophy_new(rlat,rlon)
    47   USE dimphy, only: klon
    48   USE mod_phys_lmdz_para, only: gather, bcast, &
     47  USE dimphy, ONLY: klon
     48  USE mod_phys_lmdz_para, ONLY: gather, bcast, &
    4949                                jj_nb, jj_begin, jj_end, ii_begin, ii_end, &
    5050                                mpi_size, mpi_rank, klon_mpi, &
    5151                                is_sequential, is_south_pole_dyn
    52   USE mod_grid_phy_lmdz, only: nbp_lon, nbp_lat, klon_glo
     52  USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo
    5353  USE print_control_mod, ONLY: prt_level,lunout
    5454#ifdef CPP_IOIPSL
    55   USE ioipsl, only: flio_dom_set
    56 #endif
    57 #ifdef CPP_XIOS
    58   use wxios, only: wxios_domain_param
     55  USE ioipsl, ONLY: flio_dom_set
     56#endif
     57#ifdef CPP_XIOS
     58  USE wxios, ONLY: wxios_domain_param
    5959#endif
    6060  IMPLICIT NONE
    … …  
    136136    ELSE
    137137        data_ibegin = ii_begin - 1
    138     END IF
     138    ENDIF
    139139
    140140    IF (mpi_rank == mpi_size-1) THEN
    … …  
    142142    ELSE
    143143        data_iend = ii_end + 1
    144     END IF
    145 
    146     if (prt_level>=10) then
     144    ENDIF
     145
     146    IF (prt_level>=10) THEN
    147147      write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," iibegin=",ii_begin , " ii_end=",ii_end," jjbegin=",jj_begin," jj_nb=",jj_nb," jj_end=",jj_end
    148148      write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," nbp_lon=",nbp_lon," nbp_lat=",nbp_lat
    … …  
    150150      write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
    151151      write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," is_south_pole=",is_south_pole_dyn
    152     endif
     152    ENDIF
    153153
    154154    ! Initialize the XIOS domain coreesponding to this process:
    … …  
    163163
    164164  SUBROUTINE init_iophy(lat,lon)
    165   USE mod_phys_lmdz_para, only: jj_begin, jj_end, ii_begin, ii_end, jj_nb, &
     165  USE mod_phys_lmdz_para, ONLY: jj_begin, jj_end, ii_begin, ii_end, jj_nb, &
    166166                                mpi_size, mpi_rank
    167   USE ioipsl, only: flio_dom_set
     167  USE ioipsl, ONLY: flio_dom_set
    168168  USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
    169169  IMPLICIT NONE
    … …  
    180180
    181181!$OMP MASTER 
    182     allocate(io_lat(nbp_lat))
     182    ALLOCATE(io_lat(nbp_lat))
    183183    io_lat(:)=lat(:)
    184     allocate(io_lon(nbp_lon))
     184    ALLOCATE(io_lon(nbp_lon))
    185185    io_lon(:)=lon(:)
    186186   
    … …  
    191191    dpl=(/ nbp_lon, jj_end /)
    192192    dhs=(/ ii_begin-1,0 /)
    193     if (mpi_rank==mpi_size-1) then
     193    IF (mpi_rank==mpi_size-1) THEN
    194194      dhe=(/0,0/)
    195     else
     195    ELSE
    196196      dhe=(/ nbp_lon-ii_end,0 /) 
    197     endif
     197    ENDIF
    198198   
    199199#ifndef CPP_IOIPSL_NO_OUTPUT
    … …  
    203203!$OMP END MASTER
    204204     
    205   end SUBROUTINE init_iophy
     205  END SUBROUTINE init_iophy
    206206
    207207 SUBROUTINE histbeg_phyxios(name,itau0,zjulian,dtime,ffreq,lev,nhori,nid_day)
    208208!  USE dimphy
    209   USE mod_phys_lmdz_para, only: is_sequential, is_using_mpi, is_mpi_root, &
     209  USE mod_phys_lmdz_para, ONLY: is_sequential, is_using_mpi, is_mpi_root, &
    210210                                jj_begin, jj_end, jj_nb
    211211  USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
    212   use ioipsl, only: histbeg
    213 #ifdef CPP_XIOS
    214   use wxios, only: wxios_add_file
     212  USE ioipsl, ONLY: histbeg
     213#ifdef CPP_XIOS
     214  USE wxios, ONLY: wxios_add_file
    215215#endif
    216216  IMPLICIT NONE
    217217  include 'clesphys.h'
    218218   
    219     character*(*), INTENT(IN) :: name
    220     integer, INTENT(IN) :: itau0
     219    CHARACTER*(*), INTENT(IN) :: name
     220    INTEGER, INTENT(IN) :: itau0
    221221    REAL,INTENT(IN) :: zjulian
    222222    REAL,INTENT(IN) :: dtime
    223     character(LEN=*), INTENT(IN) :: ffreq
     223    CHARACTER(LEN=*), INTENT(IN) :: ffreq
    224224    INTEGER,INTENT(IN) :: lev
    225     integer,intent(out) :: nhori
    226     integer,intent(out) :: nid_day
     225    INTEGER,INTENT(OUT) :: nhori
     226    INTEGER,INTENT(OUT) :: nid_day
    227227
    228228!$OMP MASTER   
    229     if (is_sequential) then
     229    IF (is_sequential) THEN
    230230      call histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
    231231                   1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day)
    232     else
     232    ELSE
    233233      call histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
    234234                   1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day,phys_domain_id)
    235     endif
     235    ENDIF
    236236
    237237#ifdef CPP_XIOS
    … …  
    242242        CALL wxios_add_file(name, ffreq, lev)
    243243      ENDIF
    244     END IF
     244    ENDIF
    245245#endif
    246246!$OMP END MASTER
    … …  
    250250  SUBROUTINE histbeg_phy(name,itau0,zjulian,dtime,nhori,nid_day)
    251251
    252   USE mod_phys_lmdz_para, only: jj_begin, jj_end, jj_nb, is_sequential
     252  USE mod_phys_lmdz_para, ONLY: jj_begin, jj_end, jj_nb, is_sequential
    253253  USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
    254   use ioipsl, only: histbeg
     254  USE ioipsl, ONLY: histbeg
    255255
    256256  IMPLICIT NONE
    257257   
    258     character*(*), INTENT(IN) :: name
    259     integer, INTENT(IN) :: itau0
     258    CHARACTER*(*), INTENT(IN) :: name
     259    INTEGER, INTENT(IN) :: itau0
    260260    REAL,INTENT(IN) :: zjulian
    261261    REAL,INTENT(IN) :: dtime
    262     integer,intent(out) :: nhori
    263     integer,intent(out) :: nid_day
     262    INTEGER,INTENT(OUT) :: nhori
     263    INTEGER,INTENT(OUT) :: nid_day
    264264
    265265!$OMP MASTER   
    266266#ifndef CPP_IOIPSL_NO_OUTPUT
    267     if (is_sequential) then
     267    IF (is_sequential) THEN
    268268      call histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
    269269                   1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day)
    270     else
     270    ELSE
    271271      call histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
    272272                   1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day,phys_domain_id)
    273     endif
     273    ENDIF
    274274#endif
    275275!$OMP END MASTER
    … …  
    281281             plon,plat,plon_bounds,plat_bounds, &
    282282             nname,itau0,zjulian,dtime,nnhori,nnid_day)
    283   USE dimphy, only: klon
    284   USE mod_phys_lmdz_para, only: gather, bcast, &
     283  USE dimphy, ONLY: klon
     284  USE mod_phys_lmdz_para, ONLY: gather, bcast, &
    285285                                is_sequential, klon_mpi_begin, klon_mpi_end, &
    286286                                mpi_rank
    287   USE mod_grid_phy_lmdz, only: klon_glo, nbp_lon, nbp_lat
    288   use ioipsl, only: histbeg
     287  USE mod_grid_phy_lmdz, ONLY: klon_glo, nbp_lon, nbp_lat
     288  USE ioipsl, ONLY: histbeg
    289289
    290290  IMPLICIT NONE
    … …  
    292292    REAL,DIMENSION(klon),INTENT(IN) :: rlon
    293293    REAL,DIMENSION(klon),INTENT(IN) :: rlat
    294     integer, INTENT(IN) :: itau0
     294    INTEGER, INTENT(IN) :: itau0
    295295    REAL,INTENT(IN) :: zjulian
    296296    REAL,INTENT(IN) :: dtime
    297     integer, INTENT(IN) :: pim
    298     integer, intent(out) :: nnhori
    299     character(len=20), INTENT(IN) :: nname
    300     INTEGER, intent(out) :: nnid_day
    301     integer :: i
     297    INTEGER, INTENT(IN) :: pim
     298    INTEGER, intent(out) :: nnhori
     299    CHARACTER(len=20), INTENT(IN) :: nname
     300    INTEGER, INTENT(OUT) :: nnid_day
     301    INTEGER :: i
    302302    REAL,DIMENSION(klon_glo)        :: rlat_glo
    303303    REAL,DIMENSION(klon_glo)        :: rlon_glo
    … …  
    328328     plon_bounds(i,1)=rlon_glo(tabij(i)-1)
    329329     plon_bounds(i,2)=rlon_glo(tabij(i)+1)
    330      if(plon_bounds(i,2).LE.0..AND.plon_bounds(i,1).GE.0.) THEN
    331       if(rlon_glo(tabij(i)).GE.0.) THEN
     330     IF (plon_bounds(i,2).LE.0..AND.plon_bounds(i,1).GE.0.) THEN
     331      IF (rlon_glo(tabij(i)).GE.0.) THEN
    332332       plon_bounds(i,2)=-1*plon_bounds(i,2)
    333       endif
    334      endif
    335      if(plon_bounds(i,2).GE.0..AND.plon_bounds(i,1).LE.0.) THEN
    336       if(rlon_glo(tabij(i)).LE.0.) THEN
     333      ENDIF
     334     ENDIF
     335     IF (plon_bounds(i,2).GE.0..AND.plon_bounds(i,1).LE.0.) THEN
     336      IF (rlon_glo(tabij(i)).LE.0.) THEN
    337337       plon_bounds(i,2)=-1*plon_bounds(i,2)
    338       endif
    339      endif
     338      ENDIF
     339     ENDIF
    340340!
    341341     IF ( tabij(i).LE.nbp_lon) THEN
    … …  
    361361
    362362       CALL gr_fi_ecrit(1,klon,nbp_lon,nbp_lat,rlon_glo,zx_lon)
    363        if ((nbp_lon*nbp_lat).gt.1) then
     363       IF ((nbp_lon*nbp_lat).GT.1) THEN
    364364       DO i = 1, nbp_lon
    365365         zx_lon(i,1) = rlon_glo(i+1)
    366366         zx_lon(i,nbp_lat) = rlon_glo(i+1)
    367367       ENDDO
    368        endif
     368       ENDIF
    369369       CALL gr_fi_ecrit(1,klon,nbp_lon,nbp_lat,rlat_glo,zx_lat)
    370370
    … …  
    375375     plon_bounds(i,2)=zx_lon(ipt(i)+1,jpt(i))
    376376
    377      if (ipt(i).EQ.1) then
     377     IF (ipt(i).EQ.1) THEN
    378378      plon_bounds(i,1)=zx_lon(nbp_lon,jpt(i))
    379379      plon_bounds(i,2)=360.+zx_lon(ipt(i)+1,jpt(i))
    380      endif
     380     ENDIF
    381381 
    382      if (ipt(i).EQ.nbp_lon) then
     382     IF (ipt(i).EQ.nbp_lon) THEN
    383383      plon_bounds(i,2)=360.+zx_lon(1,jpt(i))
    384      endif
     384     ENDIF
    385385
    386386     plat_bounds(i,1)=zx_lat(ipt(i),jpt(i)-1)
    387387     plat_bounds(i,2)=zx_lat(ipt(i),jpt(i)+1)
    388388
    389      if (jpt(i).EQ.1) then
     389     IF (jpt(i).EQ.1) THEN
    390390      plat_bounds(i,1)=zx_lat(ipt(i),1)+0.001
    391391      plat_bounds(i,2)=zx_lat(ipt(i),1)-0.001
    392      endif
     392     ENDIF
    393393 
    394      if (jpt(i).EQ.nbp_lat) then
     394     IF (jpt(i).EQ.nbp_lat) THEN
    395395      plat_bounds(i,1)=zx_lat(ipt(i),nbp_lat)+0.001
    396396      plat_bounds(i,2)=zx_lat(ipt(i),nbp_lat)-0.001
    397      endif
     397     ENDIF
    398398!
    399399!    print*,'CFMIP_iophy point i lon lon_bds',i,plon_bounds(i,1),rlon(tabij(i)),plon_bounds(i,2)
    … …  
    407407                           itau0, zjulian, dtime, nnhori, nnid_day)
    408408#endif
    409     else
     409    ELSE
    410410     npproc=0
    411411     DO ip=1, pim
    … …  
    448448                            itau0,zjulian,dtime,nnhori,nnid_day,phys_domain_id)
    449449#endif
    450     endif
     450    ENDIF
    451451!$OMP END MASTER
    452452
    453   end SUBROUTINE histbeg_phy_points
     453  END SUBROUTINE histbeg_phy_points
    454454
    455455
    456456  SUBROUTINE histdef2d_old (iff,lpoint,flag_var,nomvar,titrevar,unitvar)
    457457
    458     USE ioipsl, only: histdef
    459     USE mod_phys_lmdz_para, only: jj_nb
    460     use phys_output_var_mod, only: type_ecri, zoutm, zdtime_moy, lev_files, &
    461                                    nid_files, nhorim, swaero_diag, nfiles
     458    USE ioipsl, ONLY: histdef
     459    USE mod_phys_lmdz_para, ONLY: jj_nb
     460    USE phys_output_var_mod, ONLY: type_ecri, zoutm, zdtime_moy, lev_files, &
     461                                   nid_files, nhorim, swaero_diag, dryaod_diag, nfiles
    462462    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
     463    USE aero_mod, ONLY : naero_tot, name_aero_tau
     464
    463465    IMPLICIT NONE
    464466
    … …  
    466468
    467469    INTEGER                          :: iff
     470    INTEGER                          :: naero
    468471    LOGICAL                          :: lpoint
    469472    INTEGER, DIMENSION(nfiles)       :: flag_var
    470     CHARACTER(LEN=20)                 :: nomvar
     473    CHARACTER(LEN=20)                :: nomvar
    471474    CHARACTER(LEN=*)                 :: titrevar
    472475    CHARACTER(LEN=*)                 :: unitvar
    … …  
    498501
    499502    ! Set swaero_diag=true if at least one of the concerned variables are defined
    500     IF (nomvar=='topswad' .OR. nomvar=='topswai' .OR. nomvar=='solswad' .OR. nomvar=='solswai' ) THEN
    501        IF  ( flag_var(iff)<=lev_files(iff) ) THEN
    502           swaero_diag=.TRUE.
    503        END IF
    504     END IF
     503    IF (nomvar=='topswad' .OR. nomvar=='topswad0' .OR. nomvar=='solswad' .OR. nomvar=='solswad0' .OR. &
     504        nomvar=='toplwad' .OR. nomvar=='toplwad0' .OR. nomvar=='sollwad' .OR. nomvar=='sollwad0' .OR. &
     505        nomvar=='topswai' .OR. nomvar=='solswai' ) THEN
     506       IF  ( flag_var(iff)<=lev_files(iff) ) swaero_diag=.TRUE.
     507    ENDIF
     508
     509    ! Set dryaod_diag=true if at least one of the concerned variables are defined
     510    DO naero = 1, naero_tot-1
     511      PRINT *,'dryaod_diag 2=', nomvar, flag_var(iff), lev_files(iff)
     512      IF (nomvar=='dryod550_'//name_aero_tau(naero)) THEN
     513        IF  ( flag_var(iff)<=lev_files(iff) ) dryaod_diag=.TRUE.
     514      ENDIF
     515    ENDDO
     516
    505517  END SUBROUTINE histdef2d_old
    506518
    507 
    508 
    509519  SUBROUTINE histdef3d_old (iff,lpoint,flag_var,nomvar,titrevar,unitvar)
    510520
    511     USE ioipsl, only: histdef
    512     USE dimphy, only: klev
    513     USE mod_phys_lmdz_para, only: jj_nb
    514     use phys_output_var_mod, only: type_ecri, zoutm, lev_files, nid_files, &
     521    USE ioipsl, ONLY: histdef
     522    USE dimphy, ONLY: klev
     523    USE mod_phys_lmdz_para, ONLY: jj_nb
     524    USE phys_output_var_mod, ONLY: type_ecri, zoutm, lev_files, nid_files, &
    515525                                   nhorim, zdtime_moy, levmin, levmax, &
    516526                                   nvertm, nfiles
    … …  
    555565  END SUBROUTINE histdef3d_old
    556566
    557 
    558 
    559 
    560 
    561 
    562 
    563 
    564567  SUBROUTINE histdef2d (iff,var)
    565568
    566     USE ioipsl, only: histdef
    567     USE mod_phys_lmdz_para, only: jj_nb
    568     use phys_output_var_mod, only: ctrl_out, type_ecri_files, zoutm, zdtime_moy, &
     569    USE ioipsl, ONLY: histdef
     570    USE mod_phys_lmdz_para, ONLY: jj_nb
     571    USE phys_output_var_mod, ONLY: ctrl_out, type_ecri_files, zoutm, zdtime_moy, &
    569572                                   clef_stations, phys_out_filenames, lev_files, &
    570                                    nid_files, nhorim, swaero_diag
     573                                   nid_files, nhorim, swaero_diag, dryaod_diag
    571574    USE print_control_mod, ONLY: prt_level,lunout
    572575    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
    573 #ifdef CPP_XIOS
    574     use wxios, only: wxios_add_field_to_file
     576    USE aero_mod, ONLY : naero_tot, name_aero_tau
     577#ifdef CPP_XIOS
     578    USE wxios, ONLY: wxios_add_field_to_file
    575579#endif
    576580    IMPLICIT NONE
    … …  
    579583
    580584    INTEGER                          :: iff
     585    INTEGER                          :: naero
    581586    TYPE(ctrl_out)                   :: var
    582587
    583588    REAL zstophym
    584589    CHARACTER(LEN=20) :: typeecrit
    585 
    586590
    587591    ! ug On récupère le type écrit de la structure:
    … …  
    638642    ENDIF
    639643
    640     ! Set swaero_diag=true if at least one of the concerned variables are
    641     ! defined
     644    ! Set swaero_diag=true if at least one of the concerned variables are defined
    642645    !--OB 30/05/2016 use wider set of variables
     646    !--OB 14/04/2017 change location of reinitialisation to FALSE
    643647    IF ( var%name=='topswad' .OR. var%name=='topswad0' .OR. var%name=='solswad' .OR. var%name=='solswad0' .OR. &
    644648         var%name=='topswai' .OR. var%name=='solswai'  .OR. ( iflag_rrtm==1 .AND. (                            &
    645649         var%name=='toplwad' .OR. var%name=='toplwad0' .OR. var%name=='sollwad' .OR. var%name=='sollwad0' .OR. &
    646650         var%name=='toplwai' .OR. var%name=='sollwai'  ) ) ) THEN
    647        IF  ( var%flag(iff)<=lev_files(iff) ) THEN
    648           swaero_diag=.TRUE.
    649        END IF
    650     END IF
     651       IF  ( var%flag(iff)<=lev_files(iff) ) swaero_diag=.TRUE.
     652    ENDIF
     653
     654    ! set dryaod_dry=true if at least one of the concerned variables are defined
     655    IF (var%name=='dryod550aer') THEN
     656      IF  ( var%flag(iff)<=lev_files(iff) ) dryaod_diag=.TRUE.
     657    ENDIF
     658    !
     659    DO naero = 1, naero_tot-1
     660      IF (var%name=='dryod550_'//name_aero_tau(naero)) THEN
     661        IF  ( var%flag(iff)<=lev_files(iff) ) dryaod_diag=.TRUE.
     662      ENDIF
     663    ENDDO
    651664  END SUBROUTINE histdef2d
    652665
    653666  SUBROUTINE histdef3d (iff,var)
    654667
    655     USE ioipsl, only: histdef
    656     USE dimphy, only: klev
    657     USE mod_phys_lmdz_para, only: jj_nb
    658     use phys_output_var_mod, only: ctrl_out, type_ecri_files, zoutm, zdtime_moy, &
     668    USE ioipsl, ONLY: histdef
     669    USE dimphy, ONLY: klev
     670    USE mod_phys_lmdz_para, ONLY: jj_nb
     671    USE phys_output_var_mod, ONLY: ctrl_out, type_ecri_files, zoutm, zdtime_moy, &
    659672                                   clef_stations, phys_out_filenames, lev_files, &
    660                                    nid_files, nhorim, swaero_diag, levmin, &
     673                                   nid_files, nhorim, swaero_diag, dryaod_diag, levmin, &
    661674                                   levmax, nvertm
    662675    USE print_control_mod, ONLY: prt_level,lunout
    663676    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
    664677#ifdef CPP_XIOS
    665     use wxios, only: wxios_add_field_to_file
     678    USE wxios, ONLY: wxios_add_field_to_file
    666679#endif
    667680    IMPLICIT NONE
    … …  
    735748!!! Lecture des noms et niveau de sortie des variables dans output.def
    736749    !   en utilisant les routines getin de IOIPSL 
    737     use ioipsl, only: getin
    738     use phys_output_var_mod, only: nfiles
     750    USE ioipsl, ONLY: getin
     751    USE phys_output_var_mod, ONLY: nfiles
    739752    USE print_control_mod, ONLY: prt_level,lunout
    740753    IMPLICIT NONE
    … …  
    750763  END SUBROUTINE conf_physoutputs
    751764
    752 
    753765 
    754766  SUBROUTINE histwrite2d_phy_old(nid,lpoint,name,itau,field)
    755   USE dimphy, only: klon
    756   USE mod_phys_lmdz_para, only: Gather_omp, grid1Dto2D_mpi, &
     767  USE dimphy, ONLY: klon
     768  USE mod_phys_lmdz_para, ONLY: Gather_omp, grid1Dto2D_mpi, &
    757769                                is_sequential, klon_mpi_begin, klon_mpi_end, &
    758770                                jj_nb, klon_mpi
    759   USE ioipsl, only: histwrite
     771  USE ioipsl, ONLY: histwrite
    760772  USE print_control_mod, ONLY: prt_level,lunout
    761773  USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
    762774  IMPLICIT NONE
    763775   
    764     integer,INTENT(IN) :: nid
    765     logical,INTENT(IN) :: lpoint
    766     character*(*), INTENT(IN) :: name
    767     integer, INTENT(IN) :: itau
     776    INTEGER,INTENT(IN) :: nid
     777    LOGICAL,INTENT(IN) :: lpoint
     778    CHARACTER*(*), INTENT(IN) :: name
     779    INTEGER, INTENT(IN) :: itau
    768780    REAL,DIMENSION(:),INTENT(IN) :: field
    769781    REAL,DIMENSION(klon_mpi) :: buffer_omp
    … …  
    771783    REAL :: Field2d(nbp_lon,jj_nb)
    772784
    773     integer :: ip
    774     REAL,allocatable,DIMENSION(:) :: fieldok
    775 
     785    INTEGER :: ip
     786    REAL,ALLOCATABLE,DIMENSION(:) :: fieldok
    776787
    777788    IF (size(field)/=klon) CALL abort_physic('iophy::histwrite2d','Field first DIMENSION not equal to klon',1)
    … …  
    786797     CALL histwrite(nid,name,itau,Field2d,nbp_lon*jj_nb,index2d)
    787798     IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
    788     else
     799    ELSE
    789800     ALLOCATE(fieldok(npstn))
    790801     ALLOCATE(index2d(npstn))
    791802
    792      if(is_sequential) then
     803     IF (is_sequential) THEN
    793804!     klon_mpi_begin=1
    794805!     klon_mpi_end=klon
    … …  
    796807       fieldok(ip)=buffer_omp(nptabij(ip))
    797808      ENDDO
    798      else
     809     ELSE
    799810      DO ip=1, npstn
    800811!     print*,'histwrite2d is_sequential npstn ip name nptabij',npstn,ip,name,nptabij(ip)
    … …  
    804815       ENDIF
    805816      ENDDO
    806      endif
     817     ENDIF
    807818     IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL'
    808819     CALL histwrite(nid,name,itau,fieldok,npstn,index2d)
    809820     IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
    810821!
    811     endif
    812     deallocate(index2d)
    813     deallocate(fieldok)
     822    ENDIF
     823    DEALLOCATE(index2d)
     824    DEALLOCATE(fieldok)
    814825!$OMP END MASTER   
    815826
    816827 
    817   end SUBROUTINE histwrite2d_phy_old
     828  END SUBROUTINE histwrite2d_phy_old
    818829
    819830  SUBROUTINE histwrite3d_phy_old(nid,lpoint,name,itau,field)
    820   USE dimphy, only: klon
    821   USE mod_phys_lmdz_para, only: Gather_omp, grid1Dto2D_mpi, &
     831  USE dimphy, ONLY: klon
     832  USE mod_phys_lmdz_para, ONLY: Gather_omp, grid1Dto2D_mpi, &
    822833                                is_sequential, klon_mpi_begin, klon_mpi_end, &
    823834                                jj_nb, klon_mpi
    824835  USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
    825   use ioipsl, only: histwrite
     836  USE ioipsl, ONLY: histwrite
    826837  USE print_control_mod, ONLY: prt_level,lunout
    827838  IMPLICIT NONE
    828839   
    829     integer,INTENT(IN) :: nid
    830     logical,INTENT(IN) :: lpoint
    831     character*(*), INTENT(IN) :: name
    832     integer, INTENT(IN) :: itau
     840    INTEGER,INTENT(IN) :: nid
     841    LOGICAL,INTENT(IN) :: lpoint
     842    CHARACTER*(*), INTENT(IN) :: name
     843    INTEGER, INTENT(IN) :: itau
    833844    REAL,DIMENSION(:,:),INTENT(IN) :: field  ! --> field(klon,:)
    834845    REAL,DIMENSION(klon_mpi,size(field,2)) :: buffer_omp
    … …  
    845856!$OMP MASTER
    846857    CALL grid1Dto2D_mpi(buffer_omp,field3d)
    847     if(.NOT.lpoint) THEN
     858    IF (.NOT.lpoint) THEN
    848859     ALLOCATE(index3d(nbp_lon*jj_nb*nlev))
    849860     ALLOCATE(fieldok(nbp_lon*jj_nb,nlev))
    … …  
    851862     CALL histwrite(nid,name,itau,Field3d,nbp_lon*jj_nb*nlev,index3d)
    852863     IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
    853    else
     864   ELSE
    854865      nlev=size(field,2)
    855866      ALLOCATE(index3d(npstn*nlev))
    856867      ALLOCATE(fieldok(npstn,nlev))
    857868
    858       if(is_sequential) then
     869      IF (is_sequential) THEN
    859870!      klon_mpi_begin=1
    860871!      klon_mpi_end=klon
    … …  
    864875       ENDDO
    865876       ENDDO
    866       else
     877      ELSE
    867878       DO n=1, nlev
    868879       DO ip=1, npstn
    … …  
    873884       ENDDO
    874885       ENDDO
    875       endif
     886      ENDIF
    876887      IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL'
    877888      CALL histwrite(nid,name,itau,fieldok,npstn*nlev,index3d)
    878889      IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
    879     endif
    880   deallocate(index3d)
    881   deallocate(fieldok)
     890    ENDIF
     891  DEALLOCATE(index3d)
     892  DEALLOCATE(fieldok)
    882893!$OMP END MASTER   
    883894
    884   end SUBROUTINE histwrite3d_phy_old
     895  END SUBROUTINE histwrite3d_phy_old
    885896
    886897
    … …  
    889900! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
    890901  SUBROUTINE histwrite2d_phy(var,field, STD_iff)
    891   USE dimphy, only: klon
    892   USE mod_phys_lmdz_para, only: gather_omp, grid1dto2d_mpi, &
     902  USE dimphy, ONLY: klon
     903  USE mod_phys_lmdz_para, ONLY: gather_omp, grid1dto2d_mpi, &
    893904                                jj_nb, klon_mpi, klon_mpi_begin, &
    894905                                klon_mpi_end, is_sequential
    895   USE ioipsl, only: histwrite
    896   use phys_output_var_mod, only: ctrl_out, clef_files, lev_files, &
     906  USE ioipsl, ONLY: histwrite
     907  USE phys_output_var_mod, ONLY: ctrl_out, clef_files, lev_files, &
    897908                                 nfiles, vars_defined, clef_stations, &
    898909                                 nid_files
    … …  
    900911  USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
    901912#ifdef CPP_XIOS
    902   USE xios, only: xios_send_field
     913  USE xios, ONLY: xios_send_field
    903914#endif
    904915
    … …  
    932943            iff_beg = 1
    933944            iff_end = nfiles
    934       END IF
     945      ENDIF
    935946
    936947  ! On regarde si on est dans la phase de définition ou d'écriture:
    937   IF(.NOT.vars_defined) THEN
     948  IF (.NOT.vars_defined) THEN
    938949!$OMP MASTER
    939950      !Si phase de définition.... on définit
    940951      IF (.not. ok_all_xml) THEN
    941       if (prt_level >= 10) then
    942       write(lunout,*)"histwrite2d_phy: .not.vars_defined ; time to define ", &
    943                      trim(var%name)
    944       endif
     952      IF (prt_level >= 10) THEN
     953      WRITE (lunout,*)"histwrite2d_phy: .not.vars_defined ; time to define ", trim(var%name)
     954      ENDIF
    945955      DO iff=iff_beg, iff_end
    946956         IF (clef_files(iff)) THEN
    … …  
    955965    IF (SIZE(field)/=klon) CALL abort_physic('iophy::histwrite2d_phy','Field first DIMENSION not equal to klon',1)
    956966   
    957     if (prt_level >= 10) then
    958       write(lunout,*)"histwrite2d_phy: .not.vars_defined ; time to gather and write ", &
    959                      trim(var%name)
    960     endif
     967    IF (prt_level >= 10) THEn
     968      WRITE (lunout,*)"histwrite2d_phy: .not.vars_defined ; time to gather and write ", trim(var%name)
     969    ENDIF
    961970   
    962971    CALL Gather_omp(field,buffer_omp)
    … …  
    969978      IF (ok_all_xml) THEN
    970979#ifdef CPP_XIOS
    971           if (prt_level >= 10) then
    972              write(lunout,*)'Dans iophy histwrite2D,var%name ',&
    973                              trim(var%name)                       
    974           endif
     980          IF (prt_level >= 10) THEN
     981             write(lunout,*)'Dans iophy histwrite2D,var%name ', trim(var%name)                       
     982          ENDIF
    975983          CALL xios_send_field(var%name, Field2d)
    976           if (prt_level >= 10) then
    977              write(lunout,*)'Dans iophy histwrite2D,var%name apres xios_send ',&
    978                              trim(var%name)                       
    979           endif
     984          IF (prt_level >= 10) THEN
     985             WRITE (lunout,*)'Dans iophy histwrite2D,var%name apres xios_send ', trim(var%name)                       
     986          ENDIF
    980987#else
    981988        CALL abort_physic ('iophy','cannot have ok_all_xml = .T. without CPP_XIOS defined' ,1)
    … …  
    987994#ifdef CPP_XIOS
    988995               IF (firstx) THEN
    989                   if (prt_level >= 10) then
    990                      write(lunout,*)'Dans iophy histwrite2D,iff,var%name ',&
    991                                     iff,trim(var%name)                       
    992                      write(lunout,*)"histwrite2d_phy:.NOT.clef_stations(iff)and iff==iff_beg, call xios_send_field"
    993                   endif
     996                  IF (prt_level >= 10) THEN
     997                     WRITE (lunout,*)'Dans iophy histwrite2D,iff,var%name ', iff,trim(var%name)                       
     998                     WRITE (lunout,*)"histwrite2d_phy:.NOT.clef_stations(iff)and iff==iff_beg, call xios_send_field"
     999                  ENDIF
    9941000                  CALL xios_send_field(var%name, Field2d)
    9951001                  firstx=.false.
    … …  
    9971003#endif
    9981004
    999                   IF(.NOT.clef_stations(iff)) THEN
     1005                  IF (.NOT.clef_stations(iff)) THEN
    10001006                        ALLOCATE(index2d(nbp_lon*jj_nb))
    10011007                        ALLOCATE(fieldok(nbp_lon*jj_nb))
    … …  
    10291035                       ENDIF ! of IF (is_sequential)
    10301036#ifndef CPP_IOIPSL_NO_OUTPUT
    1031                        if (prt_level >= 10) then
     1037                       IF (prt_level >= 10) THEn
    10321038                         write(lunout,*)"histwrite2d_phy: clef_stations(iff) and iff==iff_beg, call wxios_write_2D"
    1033                        endif
     1039                       ENDIF
    10341040                       CALL histwrite(nid_files(iff),var%name,itau_iophy,fieldok,npstn,index2d)
    10351041#endif
    10361042                  ENDIF ! of IF(.NOT.clef_stations(iff))
    10371043                 
    1038                 deallocate(index2d)
    1039                 deallocate(fieldok)
     1044                DEALLOCATE(index2d)
     1045                DEALLOCATE(fieldok)
    10401046            ENDIF !levfiles
    10411047        ENDDO ! of DO iff=iff_beg, iff_end
    … …  
    10491055! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
    10501056  SUBROUTINE histwrite3d_phy(var, field, STD_iff)
    1051   USE dimphy, only: klon, klev
    1052   USE mod_phys_lmdz_para, only: gather_omp, grid1dto2d_mpi, &
     1057  USE dimphy, ONLY: klon, klev
     1058  USE mod_phys_lmdz_para, ONLY: gather_omp, grid1dto2d_mpi, &
    10531059                                jj_nb, klon_mpi, klon_mpi_begin, &
    10541060                                klon_mpi_end, is_sequential
    1055   USE ioipsl, only: histwrite
    1056   use phys_output_var_mod, only: ctrl_out, clef_files, lev_files, &
     1061  USE ioipsl, ONLY: histwrite
     1062  USE phys_output_var_mod, ONLY: ctrl_out, clef_files, lev_files, &
    10571063                                 nfiles, vars_defined, clef_stations, &
    10581064                                 nid_files
    10591065  USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
    10601066#ifdef CPP_XIOS
    1061   USE xios, only: xios_send_field
     1067  USE xios, ONLY: xios_send_field
    10621068#endif
    10631069  USE print_control_mod, ONLY: prt_level,lunout
    … …  
    10881094            iff_beg = 1
    10891095            iff_end = nfiles
    1090       END IF
     1096      ENDIF
    10911097
    10921098  ! On regarde si on est dans la phase de définition ou d'écriture:
    … …  
    11041110    IF (SIZE(field,1)/=klon) CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)
    11051111    nlev=SIZE(field,2)
    1106     if (nlev.eq.klev+1) then
     1112    IF (nlev.EQ.klev+1) THEN
    11071113        nlevx=klev
    1108     else
     1114    ELSE
    11091115        nlevx=nlev
    1110     endif
     1116    ENDIF
    11111117
    11121118    CALL Gather_omp(field,buffer_omp)
    … …  
    11201126      IF (ok_all_xml) THEN
    11211127#ifdef CPP_XIOS
    1122           if (prt_level >= 10) then
     1128          IF (prt_level >= 10) THEN
    11231129             write(lunout,*)'Dans iophy histwrite3D,var%name ',&
    11241130                             trim(var%name)                       
    1125           endif
     1131          ENDIF
    11261132          CALL xios_send_field(var%name, Field3d(:,:,1:nlevx))
    11271133#else
    … …  
    11351141#ifdef CPP_XIOS
    11361142              IF (firstx) THEN
    1137                 if (prt_level >= 10) then
    1138                   write(lunout,*)'Dans iophy, histwrite3D iff nlev klev firstx', &
     1143                IF (prt_level >= 10) THEn
     1144                  WRITE (lunout,*)'Dans iophy, histwrite3D iff nlev klev firstx', &
    11391145                                  iff,nlev,klev, firstx                       
    1140                   write(lunout,*)'histwrite3d_phy: call xios_send_field for ', &
     1146                  WRITE (lunout,*)'histwrite3d_phy: call xios_send_field for ', &
    11411147                                  trim(var%name), ' with iim jjm nlevx = ', &
    11421148                                  nbp_lon,jj_nb,nlevx
    1143                 endif
     1149                ENDIF
    11441150                CALL xios_send_field(var%name, Field3d(:,:,1:nlevx))
    11451151                            firstx=.false.
    … …  
    11851191#endif
    11861192                  ENDIF
    1187                   deallocate(index3d)
    1188                   deallocate(fieldok)
     1193                  DEALLOCATE(index3d)
     1194                  DEALLOCATE(fieldok)
    11891195            ENDIF
    11901196      ENDDO
    … …  
    11991205#ifdef CPP_XIOS
    12001206  SUBROUTINE histwrite2d_xios(field_name,field)
    1201   USE dimphy, only: klon
    1202   USE mod_phys_lmdz_para, only: gather_omp, grid1Dto2D_mpi, &
     1207  USE dimphy, ONLY: klon
     1208  USE mod_phys_lmdz_para, ONLY: gather_omp, grid1Dto2D_mpi, &
    12031209                                is_sequential, klon_mpi_begin, klon_mpi_end, &
    12041210                                jj_nb, klon_mpi
    12051211  USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
    1206   USE xios, only: xios_send_field
     1212  USE xios, ONLY: xios_send_field
    12071213  USE print_control_mod, ONLY: prt_level,lunout
    12081214
    … …  
    12591265    ENDIF
    12601266                 
    1261     deallocate(index2d)
    1262     deallocate(fieldok)
     1267    DEALLOCATE(index2d)
     1268    DEALLOCATE(fieldok)
    12631269!$OMP END MASTER   
    12641270
    … …  
    12691275! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
    12701276  SUBROUTINE histwrite3d_xios(field_name, field)
    1271   USE dimphy, only: klon, klev
    1272   USE mod_phys_lmdz_para, only: gather_omp, grid1Dto2D_mpi, &
     1277  USE dimphy, ONLY: klon, klev
     1278  USE mod_phys_lmdz_para, ONLY: gather_omp, grid1Dto2D_mpi, &
    12731279                                is_sequential, klon_mpi_begin, klon_mpi_end, &
    12741280                                jj_nb, klon_mpi
    1275   USE xios, only: xios_send_field
     1281  USE xios, ONLY: xios_send_field
    12761282  USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
    12771283  USE print_control_mod, ONLY: prt_level,lunout
    … …  
    13301336        ENDIF
    13311337    ENDIF
    1332     deallocate(index3d)
    1333     deallocate(fieldok)
     1338    DEALLOCATE(index3d)
     1339    DEALLOCATE(fieldok)
    13341340!$OMP END MASTER   
    13351341
    … …  
    13391345#ifdef CPP_XIOS
    13401346  SUBROUTINE histwrite0d_xios(field_name, field)
    1341   USE xios, only: xios_send_field
     1347  USE xios, ONLY: xios_send_field
    13421348  IMPLICIT NONE
    13431349

  • LMDZ5/trunk/libf/phylmd/phys_local_var_mod.F90

    r2849 r2854  
    141141      REAL, SAVE, ALLOCATABLE :: tausum_aero(:,:,:)
    142142      !$OMP THREADPRIVATE(tausum_aero)
     143      REAL, SAVE, ALLOCATABLE :: drytausum_aero(:,:)
     144      !$OMP THREADPRIVATE(drytausum_aero)
    143145      REAL, SAVE, ALLOCATABLE :: tau3d_aero(:,:,:,:)
    144146      !$OMP THREADPRIVATE(tau3d_aero)
    … …  
    167169      REAL, SAVE, ALLOCATABLE :: od550aer(:)
    168170      !$OMP THREADPRIVATE(od550aer)
     171      REAL, SAVE, ALLOCATABLE :: dryod550aer(:)
     172      !$OMP THREADPRIVATE(dryod550aer)
    169173      REAL, SAVE, ALLOCATABLE :: abs550aer(:)
    170174      !$OMP THREADPRIVATE(abs550aer)
    … …  
    500504
    501505IMPLICIT NONE
    502       allocate(t_seri(klon,klev),q_seri(klon,klev),ql_seri(klon,klev),qs_seri(klon,klev))
    503       allocate(u_seri(klon,klev),v_seri(klon,klev))
    504       allocate(l_mixmin(klon,klev,nbsrf), l_mix(klon,klev,nbsrf))
     506      ALLOCATE(t_seri(klon,klev),q_seri(klon,klev),ql_seri(klon,klev),qs_seri(klon,klev))
     507      ALLOCATE(u_seri(klon,klev),v_seri(klon,klev))
     508      ALLOCATE(l_mixmin(klon,klev,nbsrf), l_mix(klon,klev,nbsrf))
    505509      l_mix(:,:,:)=0. ; l_mixmin(:,:,:)=0. ! doit etre initialse car pas toujours remplis
    506510
    507       allocate(tr_seri(klon,klev,nbtr))
    508       allocate(d_t_dyn(klon,klev),d_q_dyn(klon,klev))
    509       allocate(d_ql_dyn(klon,klev),d_qs_dyn(klon,klev))
    510       allocate(d_q_dyn2d(klon),d_ql_dyn2d(klon),d_qs_dyn2d(klon))
    511       allocate(d_u_dyn(klon,klev),d_v_dyn(klon,klev))
    512       allocate(d_tr_dyn(klon,klev,nbtr))                   !RomP
    513       allocate(d_t_con(klon,klev),d_q_con(klon,klev))
    514       allocate(d_u_con(klon,klev),d_v_con(klon,klev))
    515       allocate(d_t_wake(klon,klev),d_q_wake(klon,klev))
    516       allocate(d_t_lsc(klon,klev),d_q_lsc(klon,klev))
    517       allocate(d_t_lwr(klon,klev),d_t_lw0(klon,klev))
    518       allocate(d_t_swr(klon,klev),d_t_sw0(klon,klev))
    519       allocate(d_ql_lsc(klon,klev),d_qi_lsc(klon,klev))
    520       allocate(d_t_ajsb(klon,klev),d_q_ajsb(klon,klev))
    521       allocate(d_t_ajs(klon,klev),d_q_ajs(klon,klev))
     511      ALLOCATE(tr_seri(klon,klev,nbtr))
     512      ALLOCATE(d_t_dyn(klon,klev),d_q_dyn(klon,klev))
     513      ALLOCATE(d_ql_dyn(klon,klev),d_qs_dyn(klon,klev))
     514      ALLOCATE(d_q_dyn2d(klon),d_ql_dyn2d(klon),d_qs_dyn2d(klon))
     515      ALLOCATE(d_u_dyn(klon,klev),d_v_dyn(klon,klev))
     516      ALLOCATE(d_tr_dyn(klon,klev,nbtr))                   !RomP
     517      ALLOCATE(d_t_con(klon,klev),d_q_con(klon,klev))
     518      ALLOCATE(d_u_con(klon,klev),d_v_con(klon,klev))
     519      ALLOCATE(d_t_wake(klon,klev),d_q_wake(klon,klev))
     520      ALLOCATE(d_t_lsc(klon,klev),d_q_lsc(klon,klev))
     521      ALLOCATE(d_t_lwr(klon,klev),d_t_lw0(klon,klev))
     522      ALLOCATE(d_t_swr(klon,klev),d_t_sw0(klon,klev))
     523      ALLOCATE(d_ql_lsc(klon,klev),d_qi_lsc(klon,klev))
     524      ALLOCATE(d_t_ajsb(klon,klev),d_q_ajsb(klon,klev))
     525      ALLOCATE(d_t_ajs(klon,klev),d_q_ajs(klon,klev))
    522526!nrlmd<
    523       allocate(d_t_ajs_w(klon,klev),d_q_ajs_w(klon,klev))
    524       allocate(d_t_ajs_x(klon,klev),d_q_ajs_x(klon,klev))
     527      ALLOCATE(d_t_ajs_w(klon,klev),d_q_ajs_w(klon,klev))
     528      ALLOCATE(d_t_ajs_x(klon,klev),d_q_ajs_x(klon,klev))
    525529!>nrlmd
    526       allocate(d_u_ajs(klon,klev),d_v_ajs(klon,klev))
    527       allocate(d_t_eva(klon,klev),d_q_eva(klon,klev))
    528       allocate(d_ql_eva(klon,klev),d_qi_eva(klon,klev))
    529       allocate(d_t_lscst(klon,klev),d_q_lscst(klon,klev))
    530       allocate(d_t_lscth(klon,klev),d_q_lscth(klon,klev))
    531       allocate(plul_st(klon),plul_th(klon))
    532       allocate(d_t_vdf(klon,klev),d_q_vdf(klon,klev),d_t_diss(klon,klev))
     530      ALLOCATE(d_u_ajs(klon,klev),d_v_ajs(klon,klev))
     531      ALLOCATE(d_t_eva(klon,klev),d_q_eva(klon,klev))
     532      ALLOCATE(d_ql_eva(klon,klev),d_qi_eva(klon,klev))
     533      ALLOCATE(d_t_lscst(klon,klev),d_q_lscst(klon,klev))
     534      ALLOCATE(d_t_lscth(klon,klev),d_q_lscth(klon,klev))
     535      ALLOCATE(plul_st(klon),plul_th(klon))
     536      ALLOCATE(d_t_vdf(klon,klev),d_q_vdf(klon,klev),d_t_diss(klon,klev))
    533537!nrlmd+jyg<
    534       allocate(d_t_vdf_w(klon,klev),d_q_vdf_w(klon,klev))
    535       allocate(d_t_vdf_x(klon,klev),d_q_vdf_x(klon,klev))
     538      ALLOCATE(d_t_vdf_w(klon,klev),d_q_vdf_w(klon,klev))
     539      ALLOCATE(d_t_vdf_x(klon,klev),d_q_vdf_x(klon,klev))
    536540!>nrlmd+jyg
    537       allocate(d_u_vdf(klon,klev),d_v_vdf(klon,klev))
    538       allocate(d_t_oli(klon,klev),d_t_oro(klon,klev))
    539       allocate(d_u_oli(klon,klev),d_v_oli(klon,klev))
    540       allocate(d_u_oro(klon,klev),d_v_oro(klon,klev))
    541       allocate(d_t_lif(klon,klev),d_t_ec(klon,klev))
    542       allocate(d_u_lif(klon,klev),d_v_lif(klon,klev))
    543       allocate(d_ts(klon,nbsrf), d_tr(klon,klev,nbtr))
     541      ALLOCATE(d_u_vdf(klon,klev),d_v_vdf(klon,klev))
     542      ALLOCATE(d_t_oli(klon,klev),d_t_oro(klon,klev))
     543      ALLOCATE(d_u_oli(klon,klev),d_v_oli(klon,klev))
     544      ALLOCATE(d_u_oro(klon,klev),d_v_oro(klon,klev))
     545      ALLOCATE(d_t_lif(klon,klev),d_t_ec(klon,klev))
     546      ALLOCATE(d_u_lif(klon,klev),d_v_lif(klon,klev))
     547      ALLOCATE(d_ts(klon,nbsrf), d_tr(klon,klev,nbtr))
    544548! Special RRTM
    545       allocate(ZLWFT0_i(klon,klev+1),ZSWFT0_i(klon,klev+1),ZFLDN0(klon,klev+1))
    546       allocate(ZFLUP0(klon,klev+1),ZFSDN0(klon,klev+1),ZFSUP0(klon,klev+1))
    547 !
    548       allocate(topswad_aero(klon), solswad_aero(klon))
    549       allocate(topswai_aero(klon), solswai_aero(klon))
    550       allocate(topswad0_aero(klon), solswad0_aero(klon))
    551      ! LW diagnostics CK
    552       allocate(toplwad_aero(klon), sollwad_aero(klon))
    553       allocate(toplwai_aero(klon), sollwai_aero(klon))
    554       allocate(toplwad0_aero(klon), sollwad0_aero(klon))
    555       ! end
    556       allocate(topsw_aero(klon,naero_grp), solsw_aero(klon,naero_grp))
    557       allocate(topsw0_aero(klon,naero_grp), solsw0_aero(klon,naero_grp))
    558       allocate(topswcf_aero(klon,3), solswcf_aero(klon,3))
    559       allocate(du_gwd_hines(klon,klev),dv_gwd_hines(klon,klev))
    560       allocate(dv_gwd_rando(klon,klev),dv_gwd_front(klon,klev))
    561       allocate(east_gwstress(klon,klev),west_gwstress(klon,klev))
    562       allocate(d_t_hin(klon,klev))
    563       allocate(d_q_ch4(klon,klev))
    564 !      allocate(tausum_aero(klon,nwave,naero_spc))
    565 !      allocate(tau3d_aero(klon,klev,nwave,naero_spc))
    566       allocate(stratomask(klon,klev))
    567 !--correction mini bug OB
    568       allocate(tausum_aero(klon,nwave,naero_tot))
    569       allocate(tau3d_aero(klon,klev,nwave,naero_tot))
    570       allocate(scdnc(klon, klev))
    571       allocate(cldncl(klon))
    572       allocate(reffclwtop(klon))
    573       allocate(lcc(klon))
    574       allocate(reffclws(klon, klev))
    575       allocate(reffclwc(klon, klev))
    576       allocate(cldnvi(klon))
    577       allocate(lcc3d(klon, klev))
    578       allocate(lcc3dcon(klon, klev))
    579       allocate(lcc3dstra(klon, klev))
    580       allocate(od443aer(klon))
    581       allocate(od550aer(klon))
    582       allocate(od865aer(klon))
    583       allocate(abs550aer(klon))
    584       allocate(ec550aer(klon,klev))
    585       allocate(od550lt1aer(klon))
    586       allocate(sconcso4(klon))
    587       allocate(sconcno3(klon))
    588       allocate(sconcoa(klon))
    589       allocate(sconcbc(klon))
    590       allocate(sconcss(klon))
    591       allocate(sconcdust(klon))
    592       allocate(concso4(klon,klev))
    593       allocate(concno3(klon,klev))
    594       allocate(concoa(klon,klev))
    595       allocate(concbc(klon,klev))
    596       allocate(concss(klon,klev))
    597       allocate(concdust(klon,klev))
    598       allocate(loadso4(klon))
    599       allocate(loadoa(klon))
    600       allocate(loadbc(klon))
    601       allocate(loadss(klon))
    602       allocate(loaddust(klon))
    603       allocate(loadno3(klon))
    604       allocate(load_tmp1(klon))
    605       allocate(load_tmp2(klon))
    606       allocate(load_tmp3(klon))
     549      ALLOCATE(ZLWFT0_i(klon,klev+1),ZSWFT0_i(klon,klev+1),ZFLDN0(klon,klev+1))
     550      ALLOCATE(ZFLUP0(klon,klev+1),ZFSDN0(klon,klev+1),ZFSUP0(klon,klev+1))
     551!
     552      ALLOCATE(topswad_aero(klon), solswad_aero(klon))
     553      ALLOCATE(topswai_aero(klon), solswai_aero(klon))
     554      ALLOCATE(topswad0_aero(klon), solswad0_aero(klon))
     555      ALLOCATE(toplwad_aero(klon), sollwad_aero(klon))
     556      ALLOCATE(toplwai_aero(klon), sollwai_aero(klon))
     557      ALLOCATE(toplwad0_aero(klon), sollwad0_aero(klon))
     558      ALLOCATE(topsw_aero(klon,naero_grp), solsw_aero(klon,naero_grp))
     559      ALLOCATE(topsw0_aero(klon,naero_grp), solsw0_aero(klon,naero_grp))
     560      ALLOCATE(topswcf_aero(klon,3), solswcf_aero(klon,3))
     561      ALLOCATE(du_gwd_hines(klon,klev),dv_gwd_hines(klon,klev))
     562      ALLOCATE(dv_gwd_rando(klon,klev),dv_gwd_front(klon,klev))
     563      ALLOCATE(east_gwstress(klon,klev),west_gwstress(klon,klev))
     564      ALLOCATE(d_t_hin(klon,klev))
     565      ALLOCATE(d_q_ch4(klon,klev))
     566      ALLOCATE(stratomask(klon,klev))
     567      ALLOCATE(tausum_aero(klon,nwave,naero_tot))
     568      ALLOCATE(drytausum_aero(klon,naero_tot))
     569      ALLOCATE(tau3d_aero(klon,klev,nwave,naero_tot))
     570      ALLOCATE(scdnc(klon, klev))
     571      ALLOCATE(cldncl(klon))
     572      ALLOCATE(reffclwtop(klon))
     573      ALLOCATE(lcc(klon))
     574      ALLOCATE(reffclws(klon, klev))
     575      ALLOCATE(reffclwc(klon, klev))
     576      ALLOCATE(cldnvi(klon))
     577      ALLOCATE(lcc3d(klon, klev))
     578      ALLOCATE(lcc3dcon(klon, klev))
     579      ALLOCATE(lcc3dstra(klon, klev))
     580      ALLOCATE(od443aer(klon))
     581      ALLOCATE(od550aer(klon))
     582      ALLOCATE(od865aer(klon))
     583      ALLOCATE(dryod550aer(klon))
     584      ALLOCATE(abs550aer(klon))
     585      ALLOCATE(ec550aer(klon,klev))
     586      ALLOCATE(od550lt1aer(klon))
     587      ALLOCATE(sconcso4(klon))
     588      ALLOCATE(sconcno3(klon))
     589      ALLOCATE(sconcoa(klon))
     590      ALLOCATE(sconcbc(klon))
     591      ALLOCATE(sconcss(klon))
     592      ALLOCATE(sconcdust(klon))
     593      ALLOCATE(concso4(klon,klev))
     594      ALLOCATE(concno3(klon,klev))
     595      ALLOCATE(concoa(klon,klev))
     596      ALLOCATE(concbc(klon,klev))
     597      ALLOCATE(concss(klon,klev))
     598      ALLOCATE(concdust(klon,klev))
     599      ALLOCATE(loadso4(klon))
     600      ALLOCATE(loadoa(klon))
     601      ALLOCATE(loadbc(klon))
     602      ALLOCATE(loadss(klon))
     603      ALLOCATE(loaddust(klon))
     604      ALLOCATE(loadno3(klon))
     605      ALLOCATE(load_tmp1(klon))
     606      ALLOCATE(load_tmp2(klon))
     607      ALLOCATE(load_tmp3(klon))
    607608
    608609!IM ajout variables CFMIP2/CMIP5
    … …  
    772773USE indice_sol_mod
    773774IMPLICIT NONE
    774       deallocate(t_seri,q_seri,ql_seri,qs_seri)
    775       deallocate(u_seri,v_seri)
    776       deallocate(l_mixmin,l_mix)
    777 
    778       deallocate(tr_seri)
    779       deallocate(d_t_dyn,d_q_dyn)
    780       deallocate(d_ql_dyn,d_qs_dyn)
    781       deallocate(d_q_dyn2d,d_ql_dyn2d,d_qs_dyn2d)
    782       deallocate(d_u_dyn,d_v_dyn)
    783       deallocate(d_tr_dyn)                      !RomP
    784       deallocate(d_t_con,d_q_con)
    785       deallocate(d_u_con,d_v_con)
    786       deallocate(d_t_wake,d_q_wake)
    787       deallocate(d_t_lsc,d_q_lsc)
    788       deallocate(d_t_lwr,d_t_lw0)
    789       deallocate(d_t_swr,d_t_sw0)
    790       deallocate(d_ql_lsc,d_qi_lsc)
    791       deallocate(d_t_ajsb,d_q_ajsb)
    792       deallocate(d_t_ajs,d_q_ajs)
     775      DEALLOCATE(t_seri,q_seri,ql_seri,qs_seri)
     776      DEALLOCATE(u_seri,v_seri)
     777      DEALLOCATE(l_mixmin,l_mix)
     778
     779      DEALLOCATE(tr_seri)
     780      DEALLOCATE(d_t_dyn,d_q_dyn)
     781      DEALLOCATE(d_ql_dyn,d_qs_dyn)
     782      DEALLOCATE(d_q_dyn2d,d_ql_dyn2d,d_qs_dyn2d)
     783      DEALLOCATE(d_u_dyn,d_v_dyn)
     784      DEALLOCATE(d_tr_dyn)                      !RomP
     785      DEALLOCATE(d_t_con,d_q_con)
     786      DEALLOCATE(d_u_con,d_v_con)
     787      DEALLOCATE(d_t_wake,d_q_wake)
     788      DEALLOCATE(d_t_lsc,d_q_lsc)
     789      DEALLOCATE(d_t_lwr,d_t_lw0)
     790      DEALLOCATE(d_t_swr,d_t_sw0)
     791      DEALLOCATE(d_ql_lsc,d_qi_lsc)
     792      DEALLOCATE(d_t_ajsb,d_q_ajsb)
     793      DEALLOCATE(d_t_ajs,d_q_ajs)
    793794!nrlmd<
    794       deallocate(d_t_ajs_w,d_q_ajs_w)
    795       deallocate(d_t_ajs_x,d_q_ajs_x)
     795      DEALLOCATE(d_t_ajs_w,d_q_ajs_w)
     796      DEALLOCATE(d_t_ajs_x,d_q_ajs_x)
    796797!>nrlmd
    797       deallocate(d_u_ajs,d_v_ajs)
    798       deallocate(d_t_eva,d_q_eva)
    799       deallocate(d_ql_eva,d_qi_eva)
    800       deallocate(d_t_lscst,d_q_lscst)
    801       deallocate(d_t_lscth,d_q_lscth)
    802       deallocate(plul_st,plul_th)
    803       deallocate(d_t_vdf,d_q_vdf,d_t_diss)
     798      DEALLOCATE(d_u_ajs,d_v_ajs)
     799      DEALLOCATE(d_t_eva,d_q_eva)
     800      DEALLOCATE(d_ql_eva,d_qi_eva)
     801      DEALLOCATE(d_t_lscst,d_q_lscst)
     802      DEALLOCATE(d_t_lscth,d_q_lscth)
     803      DEALLOCATE(plul_st,plul_th)
     804      DEALLOCATE(d_t_vdf,d_q_vdf,d_t_diss)
    804805!nrlmd+jyg<
    805       deallocate(d_t_vdf_w,d_q_vdf_w)
    806       deallocate(d_t_vdf_x,d_q_vdf_x)
     806      DEALLOCATE(d_t_vdf_w,d_q_vdf_w)
     807      DEALLOCATE(d_t_vdf_x,d_q_vdf_x)
    807808!>nrlmd+jyg
    808       deallocate(d_u_vdf,d_v_vdf)
    809       deallocate(d_t_oli,d_t_oro)
    810       deallocate(d_u_oli,d_v_oli)
    811       deallocate(d_u_oro,d_v_oro)
    812       deallocate(d_t_lif,d_t_ec)
    813       deallocate(d_u_lif,d_v_lif)
    814       deallocate(d_ts, d_tr)
    815       deallocate(topswad_aero,solswad_aero)
    816       deallocate(topswai_aero,solswai_aero)
    817       deallocate(topswad0_aero,solswad0_aero)
    818       ! LW additional CK
    819       deallocate(toplwad_aero,sollwad_aero)
    820       deallocate(toplwai_aero,sollwai_aero)
    821       deallocate(toplwad0_aero,sollwad0_aero)
    822       ! end
    823       deallocate(topsw_aero,solsw_aero)
    824       deallocate(topsw0_aero,solsw0_aero)
    825       deallocate(topswcf_aero,solswcf_aero)
    826       deallocate(stratomask)
    827       deallocate(tausum_aero)
    828       deallocate(tau3d_aero)
    829       deallocate(scdnc)
    830       deallocate(cldncl)
    831       deallocate(reffclwtop)
    832       deallocate(lcc)
    833       deallocate(reffclws)
    834       deallocate(reffclwc)
    835       deallocate(cldnvi)
    836       deallocate(lcc3d)
    837       deallocate(lcc3dcon)
    838       deallocate(lcc3dstra)
    839       deallocate(od443aer)
    840       deallocate(od550aer)
    841       deallocate(od865aer)
    842       deallocate(abs550aer)
    843       deallocate(ec550aer)
    844       deallocate(od550lt1aer)
    845       deallocate(sconcso4)
    846       deallocate(sconcno3)
    847       deallocate(sconcoa)
    848       deallocate(sconcbc)
    849       deallocate(sconcss)
    850       deallocate(sconcdust)
    851       deallocate(concso4)
    852       deallocate(concno3)
    853       deallocate(concoa)
    854       deallocate(concbc)
    855       deallocate(concss)
    856       deallocate(concdust)
    857       deallocate(loadso4)
    858       deallocate(loadoa)
    859       deallocate(loadbc)
    860       deallocate(loadss)
    861       deallocate(loaddust)
    862       deallocate(loadno3)
    863       deallocate(load_tmp1)
    864       deallocate(load_tmp2)
    865       deallocate(load_tmp3)
    866       deallocate(du_gwd_hines,dv_gwd_hines,d_t_hin)
    867       deallocate(d_q_ch4)
    868       deallocate(dv_gwd_rando,dv_gwd_front)
    869       deallocate(east_gwstress,west_gwstress)
     809      DEALLOCATE(d_u_vdf,d_v_vdf)
     810      DEALLOCATE(d_t_oli,d_t_oro)
     811      DEALLOCATE(d_u_oli,d_v_oli)
     812      DEALLOCATE(d_u_oro,d_v_oro)
     813      DEALLOCATE(d_t_lif,d_t_ec)
     814      DEALLOCATE(d_u_lif,d_v_lif)
     815      DEALLOCATE(d_ts, d_tr)
     816      DEALLOCATE(topswad_aero,solswad_aero)
     817      DEALLOCATE(topswai_aero,solswai_aero)
     818      DEALLOCATE(topswad0_aero,solswad0_aero)
     819      DEALLOCATE(toplwad_aero,sollwad_aero)
     820      DEALLOCATE(toplwai_aero,sollwai_aero)
     821      DEALLOCATE(toplwad0_aero,sollwad0_aero)
     822      DEALLOCATE(topsw_aero,solsw_aero)
     823      DEALLOCATE(topsw0_aero,solsw0_aero)
     824      DEALLOCATE(topswcf_aero,solswcf_aero)
     825      DEALLOCATE(stratomask)
     826      DEALLOCATE(tausum_aero)
     827      DEALLOCATE(drytausum_aero)
     828      DEALLOCATE(tau3d_aero)
     829      DEALLOCATE(scdnc)
     830      DEALLOCATE(cldncl)
     831      DEALLOCATE(reffclwtop)
     832      DEALLOCATE(lcc)
     833      DEALLOCATE(reffclws)
     834      DEALLOCATE(reffclwc)
     835      DEALLOCATE(cldnvi)
     836      DEALLOCATE(lcc3d)
     837      DEALLOCATE(lcc3dcon)
     838      DEALLOCATE(lcc3dstra)
     839      DEALLOCATE(od443aer)
     840      DEALLOCATE(od550aer)
     841      DEALLOCATE(od865aer)
     842      DEALLOCATE(dryod550aer)
     843      DEALLOCATE(abs550aer)
     844      DEALLOCATE(ec550aer)
     845      DEALLOCATE(od550lt1aer)
     846      DEALLOCATE(sconcso4)
     847      DEALLOCATE(sconcno3)
     848      DEALLOCATE(sconcoa)
     849      DEALLOCATE(sconcbc)
     850      DEALLOCATE(sconcss)
     851      DEALLOCATE(sconcdust)
     852      DEALLOCATE(concso4)
     853      DEALLOCATE(concno3)
     854      DEALLOCATE(concoa)
     855      DEALLOCATE(concbc)
     856      DEALLOCATE(concss)
     857      DEALLOCATE(concdust)
     858      DEALLOCATE(loadso4)
     859      DEALLOCATE(loadoa)
     860      DEALLOCATE(loadbc)
     861      DEALLOCATE(loadss)
     862      DEALLOCATE(loaddust)
     863      DEALLOCATE(loadno3)
     864      DEALLOCATE(load_tmp1)
     865      DEALLOCATE(load_tmp2)
     866      DEALLOCATE(load_tmp3)
     867      DEALLOCATE(du_gwd_hines,dv_gwd_hines,d_t_hin)
     868      DEALLOCATE(d_q_ch4)
     869      DEALLOCATE(dv_gwd_rando,dv_gwd_front)
     870      DEALLOCATE(east_gwstress,west_gwstress)
    870871
    871872!IM ajout variables CFMIP2/CMIP5
    872       deallocate(topswad_aerop, solswad_aerop)
    873       deallocate(topswai_aerop, solswai_aerop)
    874       deallocate(topswad0_aerop, solswad0_aerop)
    875       deallocate(topsw_aerop, topsw0_aerop)
    876       deallocate(solsw_aerop, solsw0_aerop)
    877       deallocate(topswcf_aerop, solswcf_aerop)
     873      DEALLOCATE(topswad_aerop, solswad_aerop)
     874      DEALLOCATE(topswai_aerop, solswai_aerop)
     875      DEALLOCATE(topswad0_aerop, solswad0_aerop)
     876      DEALLOCATE(topsw_aerop, topsw0_aerop)
     877      DEALLOCATE(solsw_aerop, solsw0_aerop)
     878      DEALLOCATE(topswcf_aerop, solswcf_aerop)
    878879
    879880!CK LW diagnostics
    880       deallocate(toplwad_aerop, sollwad_aerop)
    881       deallocate(toplwai_aerop, sollwai_aerop)
    882       deallocate(toplwad0_aerop, sollwad0_aerop)
     881      DEALLOCATE(toplwad_aerop, sollwad_aerop)
     882      DEALLOCATE(toplwai_aerop, sollwai_aerop)
     883      DEALLOCATE(toplwad0_aerop, sollwad0_aerop)
    883884
    884885! FH Ajout de celles nécessaires au phys_output_write_mod

  • LMDZ5/trunk/libf/phylmd/phys_output_ctrlout_mod.F90

    r2842 r2854  
    10601060    'sollwai', 'LW-AIE at SFR', 'W/m2', (/ ('', i=1, 10) /))
    10611061
    1062 
    10631062  TYPE(ctrl_out),SAVE,DIMENSION(naero_tot) :: o_tausumaero =                              &
    1064        (/ ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'OD550_'//name_aero_tau(1),     &
     1063       (/ ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'od550_'//name_aero_tau(1),     &
    10651064       "Aerosol Optical depth at 550 nm "//name_aero_tau(1),"1", (/ ('', i=1, 10) /)),     &
    1066        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'OD550_'//name_aero_tau(2),        &
     1065       ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'od550_'//name_aero_tau(2),        &
    10671066       "Aerosol Optical depth at 550 nm "//name_aero_tau(2),"2", (/ ('', i=1, 10) /)),     &
    1068        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'OD550_'//name_aero_tau(3),        &
     1067       ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'od550_'//name_aero_tau(3),        &
    10691068       "Aerosol Optical depth at 550 nm "//name_aero_tau(3),"3", (/ ('', i=1, 10) /)),     &
    1070        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'OD550_'//name_aero_tau(4),        &
     1069       ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'od550_'//name_aero_tau(4),        &
    10711070       "Aerosol Optical depth at 550 nm "//name_aero_tau(4),"4", (/ ('', i=1, 10) /)),     &
    1072        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'OD550_'//name_aero_tau(5),        &
     1071       ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'od550_'//name_aero_tau(5),        &
    10731072       "Aerosol Optical depth at 550 nm "//name_aero_tau(5),"5", (/ ('', i=1, 10) /)),     &
    1074        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'OD550_'//name_aero_tau(6),        &
     1073       ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'od550_'//name_aero_tau(6),        &
    10751074       "Aerosol Optical depth at 550 nm "//name_aero_tau(6),"6", (/ ('', i=1, 10) /)),     &
    1076        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'OD550_'//name_aero_tau(7),        &
     1075       ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'od550_'//name_aero_tau(7),        &
    10771076       "Aerosol Optical depth at 550 nm "//name_aero_tau(7),"7", (/ ('', i=1, 10) /)),     &
    1078        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'OD550_'//name_aero_tau(8),        &
     1077       ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'od550_'//name_aero_tau(8),        &
    10791078       "Aerosol Optical depth at 550 nm "//name_aero_tau(8),"8", (/ ('', i=1, 10) /)),     &
    1080        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'OD550_'//name_aero_tau(9),        &
     1079       ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'od550_'//name_aero_tau(9),        &
    10811080       "Aerosol Optical depth at 550 nm "//name_aero_tau(9),"9", (/ ('', i=1, 10) /)),     &
    1082        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'OD550_'//name_aero_tau(10),       &
     1081       ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'od550_'//name_aero_tau(10),       &
    10831082       "Aerosol Optical depth at 550 nm "//name_aero_tau(10),"10", (/ ('', i=1, 10) /)),   &
    1084        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'OD550_'//name_aero_tau(11),       &
     1083       ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'od550_'//name_aero_tau(11),       &
    10851084       "Aerosol Optical depth at 550 nm "//name_aero_tau(11),"11", (/ ('', i=1, 10) /)),   &
    1086        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'OD550_'//name_aero_tau(12),       &
     1085       ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'od550_'//name_aero_tau(12),       &
    10871086       "Aerosol Optical depth at 550 nm "//name_aero_tau(12),"12", (/ ('', i=1, 10) /)),   &
    1088        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'OD550_'//name_aero_tau(13),       &
     1087       ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'od550_'//name_aero_tau(13),       &
    10891088       "Aerosol Optical depth at 550 nm "//name_aero_tau(13),"13", (/ ('', i=1, 10) /)),   &
    1090        ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'OD550_'//name_aero_tau(14),       &
     1089       ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'od550_'//name_aero_tau(14),       &
    10911090       "Aerosol Optical depth at 550 nm "//name_aero_tau(14),"14", (/ ('', i=1, 10) /)) /)
     1091
     1092  TYPE(ctrl_out),SAVE,DIMENSION(naero_tot-1) :: o_drytausumaero =                              &
     1093       (/ ctrl_out((/ 11, 10, 10, 10, 10, 10, 11, 11, 11, 11/),'dryod550_'//name_aero_tau(1),     &
     1094       "Dry aerosol Optical depth at 550 nm "//name_aero_tau(1),"1", (/ ('', i=1, 10) /)),     &
     1095       ctrl_out((/ 11, 10, 10, 10, 10, 10, 11, 11, 11, 11/),'dryod550_'//name_aero_tau(2),        &
     1096       "Dry aerosol Optical depth at 550 nm "//name_aero_tau(2),"2", (/ ('', i=1, 10) /)),     &
     1097       ctrl_out((/ 11, 10, 10, 10, 10, 10, 11, 11, 11, 11/),'dryod550_'//name_aero_tau(3),        &
     1098       "Dry aerosol Optical depth at 550 nm "//name_aero_tau(3),"3", (/ ('', i=1, 10) /)),     &
     1099       ctrl_out((/ 11, 10, 10, 10, 10, 10, 11, 11, 11, 11/),'dryod550_'//name_aero_tau(4),        &
     1100       "Dry aerosol Optical depth at 550 nm "//name_aero_tau(4),"4", (/ ('', i=1, 10) /)),     &
     1101       ctrl_out((/ 11, 10, 10, 10, 10, 10, 11, 11, 11, 11/),'dryod550_'//name_aero_tau(5),        &
     1102       "Dry aerosol Optical depth at 550 nm "//name_aero_tau(5),"5", (/ ('', i=1, 10) /)),     &
     1103       ctrl_out((/ 11, 10, 10, 10, 10, 10, 11, 11, 11, 11/),'dryod550_'//name_aero_tau(6),        &
     1104       "Dry aerosol Optical depth at 550 nm "//name_aero_tau(6),"6", (/ ('', i=1, 10) /)),     &
     1105       ctrl_out((/ 11, 10, 10, 10, 10, 10, 11, 11, 11, 11/),'dryod550_'//name_aero_tau(7),        &
     1106       "Dry aerosol Optical depth at 550 nm "//name_aero_tau(7),"7", (/ ('', i=1, 10) /)),     &
     1107       ctrl_out((/ 11, 10, 10, 10, 10, 10, 11, 11, 11, 11/),'dryod550_'//name_aero_tau(8),        &
     1108       "Dry aerosol Optical depth at 550 nm "//name_aero_tau(8),"8", (/ ('', i=1, 10) /)),     &
     1109       ctrl_out((/ 11, 10, 10, 10, 10, 10, 11, 11, 11, 11/),'dryod550_'//name_aero_tau(9),        &
     1110       "Dry aerosol Optical depth at 550 nm "//name_aero_tau(9),"9", (/ ('', i=1, 10) /)),     &
     1111       ctrl_out((/ 11, 10, 10, 10, 10, 10, 11, 11, 11, 11/),'dryod550_'//name_aero_tau(10),       &
     1112       "Dry aerosol Optical depth at 550 nm "//name_aero_tau(10),"10", (/ ('', i=1, 10) /)),   &
     1113       ctrl_out((/ 11, 10, 10, 10, 10, 10, 11, 11, 11, 11/),'dryod550_'//name_aero_tau(11),       &
     1114       "Dry aerosol Optical depth at 550 nm "//name_aero_tau(11),"11", (/ ('', i=1, 10) /)),   &
     1115       ctrl_out((/ 11, 10, 10, 10, 10, 10, 11, 11, 11, 11/),'dryod550_'//name_aero_tau(12),       &
     1116       "Dry aerosol Optical depth at 550 nm "//name_aero_tau(12),"12", (/ ('', i=1, 10) /)),   &
     1117       ctrl_out((/ 11, 10, 10, 10, 10, 10, 11, 11, 11, 11/),'dryod550_'//name_aero_tau(13),       &
     1118       "Dry aerosol Optical depth at 550 nm "//name_aero_tau(13),"13", (/ ('', i=1, 10) /)) /)
    10921119!
    10931120  TYPE(ctrl_out), SAVE :: o_tausumaero_lw = ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/), &
    1094     'OD_10um_STRAT', 'Stratospheric Aerosol Optical depth at 10 um ', '1', (/ ('', i=1, 10) /))
     1121    'od_10um_STRAT', 'Stratospheric Aerosol Optical depth at 10 um ', '1', (/ ('', i=1, 10) /))
    10951122!
    10961123  TYPE(ctrl_out), SAVE :: o_od443aer = ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/), &
    … …  
    10981125  TYPE(ctrl_out), SAVE :: o_od550aer = ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/), &
    10991126    'od550aer', 'Total aerosol optical depth at 550nm', '-', (/ ('', i=1, 10) /))
     1127  TYPE(ctrl_out), SAVE :: o_dryod550aer = ctrl_out((/ 11, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
     1128    'dryod550aer', 'Total dry aerosol optical depth at 550nm', '-', (/ ('', i=1, 10) /))
    11001129  TYPE(ctrl_out), SAVE :: o_od865aer = ctrl_out((/ 2, 6, 10, 10, 10, 10, 11, 11, 11, 11/), &
    11011130    'od865aer', 'Total aerosol optical depth at 870nm', '-', (/ ('', i=1, 10) /))
    … …  
    11851214!--strat aerosol optical depth
    11861215  TYPE(ctrl_out), SAVE :: o_tau_strat_550 = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
    1187     'OD550_strat_only', 'Stratospheric Aerosol Optical depth at 550 nm ', '1', (/ ('', i=1, 10) /))
     1216    'od550_strat_only', 'Stratospheric Aerosol Optical depth at 550 nm ', '1', (/ ('', i=1, 10) /))
    11881217  TYPE(ctrl_out), SAVE :: o_tau_strat_1020 = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
    11891218    'OD1020_strat_only', 'Stratospheric Aerosol Optical depth at 1020 nm ', '1', (/ ('', i=1, 10) /))

  • LMDZ5/trunk/libf/phylmd/phys_output_mod.F90

    r2833 r2854  
    519519    IF (prt_level >= 10) THEN
    520520      WRITE(lunout,*)'swaero_diag=',swaero_diag
     521      WRITE(lunout,*)'dryaod_diag=',dryaod_diag
    521522      WRITE(lunout,*)'phys_output_open: ends here'
    522523    ENDIF

  • LMDZ5/trunk/libf/phylmd/phys_output_var_mod.F90

    r2804 r2854  
    44MODULE phys_output_var_mod
    55
    6   use dimphy
     6  USE dimphy
    77  ! Variables outputs pour les ecritures des sorties
    88  !======================================================================
    … …  
    7979
    8080  ! swaero_diag : flag indicates if it is necessary to do calculation for some aerosol diagnostics
     81  ! dryaod_diag : flag indicates if it is necessary to do calculation for some aerosol diagnostics
    8182  !--OB: this needs to be set to TRUE by default and changed back to FALSE after first radiation call
    8283  !--    and corrected back to TRUE based on output requests
    8384  LOGICAL, SAVE                                :: swaero_diag=.TRUE.
    84   !$OMP THREADPRIVATE(swaero_diag)
     85  LOGICAL, SAVE                                :: dryaod_diag=.TRUE.
     86  !$OMP THREADPRIVATE(swaero_diag, dryaod_diag)
    8587
    8688  INTEGER, SAVE:: levmin(nfiles) = 1
    … …  
    165167  !======================================================================
    166168  SUBROUTINE phys_output_var_end
    167     use dimphy
     169    USE dimphy
    168170    IMPLICIT NONE
    169171

  • LMDZ5/trunk/libf/phylmd/phys_output_write_mod.F90

    r2842 r2854  
    100100         o_solldown, o_dtsvdfo, o_dtsvdft, &
    101101         o_dtsvdfg, o_dtsvdfi, o_z0m, o_z0h, o_od443aer, o_od550aer, &
    102          o_od865aer, o_abs550aer, o_od550lt1aer, &
     102         o_dryod550aer, o_od865aer, o_abs550aer, o_od550lt1aer, &
    103103         o_sconcso4, o_sconcno3, o_sconcoa, o_sconcbc, &
    104104         o_sconcss, o_sconcdust, o_concso4, o_concno3, &
    105105         o_concoa, o_concbc, o_concss, o_concdust, &
    106106         o_loadso4, o_loadoa, o_loadbc, o_loadss, &
    107          o_loaddust, o_loadno3, o_tausumaero, o_tausumaero_lw, &
     107         o_loaddust, o_loadno3, o_tausumaero, &
     108         o_drytausumaero, o_tausumaero_lw, &
    108109         o_topswad, o_topswad0, o_solswad, o_solswad0, &
    109110         o_toplwad, o_toplwad0, o_sollwad, o_sollwad0, &
    … …  
    252253         weak_inversion, dthmin, cldtau, cldemi, &
    253254         pmflxr, pmflxs, prfl, psfl, re, fl, rh2m, &
    254          qsat2m, tpote, tpot, d_ts, od443aer, od550aer, &
     255         qsat2m, tpote, tpot, d_ts, od443aer, od550aer, dryod550aer, &
    255256         od865aer, abs550aer, od550lt1aer, sconcso4, sconcno3, &
    256257         sconcoa, sconcbc, sconcss, sconcdust, concso4, concno3, &
    257258         concoa, concbc, concss, concdust, loadso4, &
    258          loadoa, loadbc, loadss, loaddust, loadno3, tausum_aero, &
     259         loadoa, loadbc, loadss, loaddust, loadno3, tausum_aero, drytausum_aero, &
    259260         topswad_aero, topswad0_aero, solswad_aero, &
    260261         solswad0_aero, topsw_aero, solsw_aero, &
    … …  
    301302    USE phys_output_var_mod, ONLY: vars_defined, snow_o, zfra_o, bils_diss, &
    302303         bils_ec,bils_ech, bils_tke, bils_kinetic, bils_latent, bils_enthalp, &
    303          itau_con, nfiles, clef_files, nid_files, &
     304         itau_con, nfiles, clef_files, nid_files, dryaod_diag, &
    304305         zustr_gwd_hines, zvstr_gwd_hines,zustr_gwd_rando, zvstr_gwd_rando, &
    305306         zustr_gwd_front, zvstr_gwd_front,     &
    … …  
    11641165       CALL histwrite_phy(o_z0m, z0m(:,nbsrf+1))
    11651166       CALL histwrite_phy(o_z0h, z0h(:,nbsrf+1))
    1166        ! OD550 per species
     1167       ! od550 per species
    11671168!--OLIVIER
    11681169!This is warranted by treating INCA aerosols as offline aerosols
    … …  
    11931194             CALL histwrite_phy(o_loaddust, loaddust)
    11941195             CALL histwrite_phy(o_loadno3, loadno3)
    1195              !--STRAT AER
    1196           ENDIF
     1196             CALL histwrite_phy(o_dryod550aer, dryod550aer)
     1197             DO naero = 1, naero_tot-1
     1198                CALL histwrite_phy(o_drytausumaero(naero),drytausum_aero(:,naero))
     1199             END DO
     1200          ENDIF
     1201          !--STRAT AER
    11971202          IF (flag_aerosol.GT.0.OR.flag_aerosol_strat.GT.0) THEN
    11981203             DO naero = 1, naero_tot

  • LMDZ5/trunk/libf/phylmd/physiq_mod.F90

    r2852 r2854  
    9292       topswcf_aero,solswcf_aero,   &
    9393       tausum_aero,tau3d_aero,      &
     94       drytausum_aero,              &
    9495       !
    9596       !variables CFMIP2/CMIP5
    … …  
    15801581           !!!  xios_field_is_active("toplwai").OR.xios_field_is_active("sollwai") !))) &
    15811582           swaero_diag=.TRUE.
     1583
     1584       !--setting up dryaod_diag to TRUE in XIOS case
     1585       DO naero = 1, naero_tot-1
     1586         IF (xios_field_is_active("dryod550_"//name_aero_tau(naero)) dryaod_diag=.TRUE.
     1587       ENDDO
    15821588#endif
    15831589
    … …  
    33713377                        tr_seri, mass_solu_aero, mass_solu_aero_pi,  &
    33723378                        tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,  &
    3373                         tausum_aero, tau3d_aero)
     3379                        tausum_aero, drytausum_aero, tau3d_aero)
    33743380#endif
    33753381                   !
    … …  
    34113417       ELSE   !--flag_aerosol = 0
    34123418          tausum_aero(:,:,:) = 0.
     3419          drytausum_aero(:,:) = 0.
    34133420          mass_solu_aero(:,:) = 0.
    34143421          mass_solu_aero_pi(:,:) = 0.
    … …  
    36783685#ifndef CPP_XIOS
    36793686          !--OB 30/05/2016 modified 21/10/2016
    3680           !--here we return swaero_diag to FALSE
     3687          !--here we return swaero_diag and dryaod_diag to FALSE
    36813688          !--and histdef will switch it back to TRUE if necessary
    36823689          !--this is necessary to get the right swaero at first step
    36833690          !--but only in the case of no XIOS as XIOS is covered elsewhere
    36843691          IF (debut) swaero_diag = .FALSE.
     3692          IF (debut) dryaod_diag = .FALSE.
    36853693#endif
    36863694          !

  • LMDZ5/trunk/libf/phylmd/rrtm/aeropt_5wv_rrtm.F90

    r2842 r2854  
    88   flag_bc_internal_mixture, &
    99   pplay, t_seri,            &
    10    tausum, tau )
     10   tausum, drytausum, tau )
    1111
    1212  USE DIMPHY
    1313  USE aero_mod
    14   USE phys_local_var_mod, ONLY: od443aer,od550aer,od865aer,ec550aer,od550lt1aer,abs550aer
     14  USE phys_local_var_mod, ONLY: od443aer,od550aer,dryod550aer,od865aer,ec550aer,od550lt1aer,abs550aer
     15  USE phys_output_var_mod, ONLY: dryaod_diag
    1516  USE YOMCST, ONLY: RD,RG
    1617
    … …  
    6768  REAL, DIMENSION(klon), INTENT(OUT)                      :: ai      ! POLDER aerosol index
    6869  REAL, DIMENSION(klon,nwave,naero_tot), INTENT(OUT)      :: tausum
     70  REAL, DIMENSION(klon,naero_tot), INTENT(OUT)            :: drytausum
    6971  REAL, DIMENSION(klon,klev,nwave,naero_tot), INTENT(OUT) :: tau
    7072  !
    … …  
    342344  ! Initialisations
    343345  ai(:) = 0.
     346  abs550aer(:)=0.0
     347  drytausum(:,:) = 0.
    344348  tausum(:,:,:) = 0.
    345349  tau(:,:,:,:)=0.
    346 
    347   abs550aer(:)=0.0
    348350
    349351  DO k=1, klev
    … …  
    476478    DO la=1,las
    477479
    478     !--only 443, 550, 670 and 865 nm are used
     480    !--only 443, 550, and 865 nm are used
    479481    !--to save time 670 and AI are not computed for CMIP6
    480482    !IF (la.NE.la443.AND.la.NE.la550.AND.la.NE.la670.AND.la.NE.la865) CYCLE
    … …  
    511513             tausum(i,la,aerindex)=tausum(i,la,aerindex)+tau(i,k,la,aerindex)
    512514
     515             IF (la.EQ.la550.AND.dryaod_diag) THEN
     516                tau_ae5wv_int = alpha_MG_5wv(1,la,classbc)
     517                drytausum(i,aerindex)=drytausum(i,aerindex)+m_allaer(i,k,aerindex)/1.e6*zdh(i,k)*tau_ae5wv_int*fac
     518             ENDIF
     519
    513520             IF (la.EQ.la550) THEN
    514521                abs_ae5wv_int = abs_MG_5wv(RH_num(i,k),la,classbc)+DELTA(i,k)* &
    … …  
    532539              tausum(i,la,aerindex)=tausum(i,la,aerindex)+tau(i,k,la,aerindex)
    533540
     541              IF (la.EQ.la550.AND.dryaod_diag) THEN
     542                 tau_ae5wv_int = alpha_aers_5wv(1,la,spsol)
     543                 drytausum(i,aerindex)=drytausum(i,aerindex)+m_allaer(i,k,aerindex)/1.e6*zdh(i,k)*tau_ae5wv_int*fac
     544              ENDIF
     545
    534546              IF (la.EQ.la550) THEN
    535547                 abs_ae5wv_int = abs_aers_5wv(RH_num(i,k),la,spsol)+DELTA(i,k)* &
    … …  
    554566            tausum(i,la,aerindex)= tausum(i,la,aerindex)+tau(i,k,la,aerindex)
    555567
     568            IF (la.EQ.la550.AND.dryaod_diag) THEN
     569              drytausum(i,aerindex)= drytausum(i,aerindex)+tau(i,k,la,aerindex)
     570            ENDIF
     571
    556572            IF (la.EQ.la550) THEN
    557573               abs_ae5wv_int = abs_aeri_5wv(la,spsol)
    … …  
    573589  od865aer(:)=SUM(tausum(:,la865,:),dim=2)
    574590
     591!--dry AOD calculation for diagnostics la=la550
     592  dryod550aer(:)=SUM(drytausum(:,:),dim=2)
     593
    575594!--extinction coefficient for diagnostic
    576595  ec550aer(:,:)=SUM(tau(:,:,la550,:),dim=3)/zdh(:,:)

  • LMDZ5/trunk/libf/phylmd/rrtm/readaerosol_optic_rrtm.F90

    r2823 r2854  
    66     tr_seri, mass_solu_aero, mass_solu_aero_pi, &
    77     tau_aero, piz_aero, cg_aero, &
    8      tausum_aero, tau3d_aero )
     8     tausum_aero, drytausum_aero, tau3d_aero )
    99
    1010  ! This routine will :
    … …  
    5252  REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: cg_aero     ! asymmetry parameter aerosol
    5353  REAL, DIMENSION(klon,nwave,naero_tot), INTENT(OUT)       :: tausum_aero
     54  REAL, DIMENSION(klon,naero_tot), INTENT(OUT)             :: drytausum_aero
    5455  REAL, DIMENSION(klon,klev,nwave,naero_tot), INTENT(OUT)  :: tau3d_aero
    5556
    … …  
    320321       flag_bc_internal_mixture,     &
    321322       pplay, t_seri,                &
    322        tausum_aero, tau3d_aero )
     323       tausum_aero, drytausum_aero, tau3d_aero )
    323324
    324325  !--call LW optical properties for tropospheric aerosols
Note: See TracChangeset for help on using the changeset viewer.