Ignore:
Timestamp:
Nov 20, 2016, 2:15:32 PM (8 years ago)
Author:
oboucher
Message:

This revision concerns the StratAer? module and should not impact the rest of LMDz
Bug correction in interp_sulf_input.F90
Update of miecalc_aer.F90 and traccoag_mod.F90
Phytrac tracers are now dealt with in XIOS through the Fortran interface with minimal input in the xml
Making tracer groups in DefLists? for StratAer?

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

Legend:

Unmodified
Added
Removed

  • LMDZ5/trunk/libf/phylmd/StratAer/interp_sulf_input.F90

    r2695 r2704  
    7171!$OMP THREADPRIVATE(OCS_clim,SO2_clim)
    7272!
    73   INTEGER i, k, kk, ilon, ilev, j
     73  INTEGER i, k, kk, j
    7474  REAL p_bound
    7575
    … …  
    8989  5.53084382e+01,   3.35462635e+01,   0.0           /)
    9090!
    91   REAL, PARAMETER :: epsilon_OCS=1.0e-20     ! minimum OCS concentration [kg/kgA] for weighting of lifetime
    92   REAL, PARAMETER :: epsilon_SO2=1.0e-20     ! minimum SO2 concentration [kg/kgA] for weighting of lifetime
    93   REAL, PARAMETER :: min_OCS_lifetime= 3600. !minimum OCS lifetime [sec]
    94   REAL, PARAMETER :: min_SO2_lifetime=86400. !minimum SO2 lifetime [sec]
    95 
    9691 IF (.NOT.ALLOCATED(OCS_clim)) ALLOCATE(OCS_clim(klon,klev))
    9792 IF (.NOT.ALLOCATED(SO2_clim)) ALLOCATE(SO2_clim(klon,klev))
    … …  
    183178
    184179  !---regrid weighted lifetime and climatologies
    185   DO i=1, klon
     180  DO i=1, klon_glo
    186181    DO k=1, klev
    187182     OCS_lifetime_glo(i,k)=0.0
    … …  
    206201  ENDDO
    207202
    208   ENDIF ! is_mpi_root
     203  ENDIF !--is_mpi_root and is_omp_root
    209204
    210205!--keep memory of previous month
    … …  
    255250
    256251  !convert SO2_backgr_tend from kg(SO2)/kgA to kg(S)/m2/layer/s for saving as diagnostic
    257   DO ilon=1, klon
    258     DO ilev=1, klev
    259       SO2_backgr_tend(ilon,ilev)=SO2_backgr_tend(ilon,ilev)*mSatom/mSO2mol*(paprs(ilon,ilev)-paprs(ilon,ilev+1))/RG/pdtphys
    260       OCS_backgr_tend(ilon,ilev)=OCS_backgr_tend(ilon,ilev)*mSatom/mOCSmol*(paprs(ilon,ilev)-paprs(ilon,ilev+1))/RG/pdtphys
     252  DO i=1, klon
     253    DO k=1, klev
     254      SO2_backgr_tend(i,k)=SO2_backgr_tend(i,k)*mSatom/mSO2mol*(paprs(i,k)-paprs(i,k+1))/RG/pdtphys
     255      OCS_backgr_tend(i,k)=OCS_backgr_tend(i,k)*mSatom/mOCSmol*(paprs(i,k)-paprs(i,k+1))/RG/pdtphys
    261256    ENDDO
    262257  ENDDO

  • LMDZ5/trunk/libf/phylmd/StratAer/miecalc_aer.F90

    r2690 r2704  
    2424  USE mod_grid_phy_lmdz, ONLY : klon_glo
    2525  USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
     26  USE print_control_mod, ONLY: prt_level, lunout
    2627
    2728  IMPLICIT NONE
    … …  
    7071  PARAMETER (Nbin=10)
    7172
    72 !--has to be consistent with dataset
    73   INTEGER nb_lambda_h2so4
    74   PARAMETER (nb_lambda_h2so4=62) !61, 235
    7573
    7674!---wavelengths STREAMER
    … …  
    131129  REAL final_w(1:NwvmaxSW+nwave_sw+nwave_lw+NwvmaxLW)
    132130
    133   INTEGER band, bandSW, bandLW
     131  INTEGER band, bandSW, bandLW, wavenumber
    134132
    135133!---wavelengths SW RRTM
    … …  
    156154  REAL ss_g(nbands_sw_rrtm+nbands_lw_rrtm+nwave_sw+nwave_lw)
    157155
    158   REAL wavenumber
    159   REAL, DIMENSION(nb_lambda_h2so4,4) :: ref_ind
    160 
     156  INTEGER, PARAMETER :: nb_lambda_h2so4=62
     157  REAL, DIMENSION (nb_lambda_h2so4,4) :: ref_ind
     158  !-- fichier h2so4_0.75_300.00_hummel_1988_p_q.dat
     159  ! -- wavenumber (cm-1), wavelength (um), n_r, n_i
     160  DATA ref_ind /                                &
     161   200.000,   50.0000,   2.01000,   6.5000E-01, &
     162   250.000,   40.0000,   1.94000,   6.3000E-01, &
     163   285.714,   35.0000,   1.72000,   5.2000E-01, &
     164   333.333,   30.0000,   1.73000,   2.9000E-01, &
     165   358.423,   27.9000,   1.78000,   2.5000E-01, &
     166   400.000,   25.0000,   1.84000,   2.4000E-01, &
     167   444.444,   22.5000,   1.82000,   2.9000E-01, &
     168   469.484,   21.3000,   1.79000,   2.5000E-01, &
     169   500.000,   20.0000,   1.81000,   2.3000E-01, &
     170   540.541,   18.5000,   1.92700,   3.0200E-01, &
     171   555.556,   18.0000,   1.95000,   4.1000E-01, &
     172   581.395,   17.2000,   1.72400,   5.9000E-01, &
     173   609.756,   16.4000,   1.52000,   4.1400E-01, &
     174   666.667,   15.0000,   1.59000,   2.1100E-01, &
     175   675.676,   14.8000,   1.61000,   2.0500E-01, &
     176   714.286,   14.0000,   1.64000,   1.9500E-01, &
     177   769.231,   13.0000,   1.69000,   1.9500E-01, &
     178   800.000,   12.5000,   1.74000,   1.9800E-01, &
     179   869.565,   11.5000,   1.89000,   3.7400E-01, &
     180   909.091,   11.0000,   1.67000,   4.8500E-01, &
     181   944.198,   10.5910,   1.72000,   3.4000E-01, &
     182  1000.000,   10.0000,   1.89000,   4.5500E-01, &
     183  1020.408,    9.8000,   1.91000,   6.8000E-01, &
     184  1052.632,    9.5000,   1.67000,   7.5000E-01, &
     185  1086.957,    9.2000,   1.60000,   5.8600E-01, &
     186  1111.111,    9.0000,   1.65000,   6.3300E-01, &
     187  1149.425,    8.7000,   1.53000,   7.7200E-01, &
     188  1176.471,    8.5000,   1.37000,   7.5500E-01, &
     189  1219.512,    8.2000,   1.20000,   6.4500E-01, &
     190  1265.823,    7.9000,   1.14000,   4.8800E-01, &
     191  1388.889,    7.2000,   1.21000,   1.7600E-01, &
     192  1538.462,    6.5000,   1.37000,   1.2800E-01, &
     193  1612.903,    6.2000,   1.42400,   1.6500E-01, &
     194  1666.667,    6.0000,   1.42500,   1.9500E-01, &
     195  1818.182,    5.5000,   1.33700,   1.8300E-01, &
     196  2000.000,    5.0000,   1.36000,   1.2100E-01, &
     197  2222.222,    4.5000,   1.38500,   1.2000E-01, &
     198  2500.000,    4.0000,   1.39800,   1.2600E-01, &
     199  2666.667,    3.7500,   1.39600,   1.3100E-01, &
     200  2857.143,    3.5000,   1.37600,   1.5800E-01, &
     201  2948.113,    3.3920,   1.35200,   1.5900E-01, &
     202  3125.000,    3.2000,   1.31100,   1.3500E-01, &
     203  3333.333,    3.0000,   1.29300,   9.5500E-02, &
     204  3703.704,    2.7000,   1.30300,   5.7000E-03, &
     205  4000.000,    2.5000,   1.34400,   3.7600E-03, &
     206  4444.444,    2.2500,   1.37000,   1.8000E-03, &
     207  5000.000,    2.0000,   1.38400,   1.2600E-03, &
     208  5555.556,    1.8000,   1.39000,   5.5000E-04, &
     209  6510.417,    1.5360,   1.40300,   1.3700E-04, &
     210  7692.308,    1.3000,   1.41000,   1.0000E-05, &
     211  9433.962,    1.0600,   1.42000,   1.5000E-06, &
     212 11627.907,    0.8600,   1.42500,   1.7900E-07, &
     213 14409.222,    0.6940,   1.42800,   1.9900E-08, &
     214 15797.788,    0.6330,   1.42900,   1.4700E-08, &
     215 18181.818,    0.5500,   1.43000,   1.0000E-08, &
     216 19417.476,    0.5150,   1.43100,   1.0000E-08, &
     217 20491.803,    0.4880,   1.43200,   1.0000E-08, &
     218 25000.000,    0.4000,   1.44000,   1.0000E-08, &
     219 29673.591,    0.3370,   1.45900,   1.0000E-08, &
     220 33333.333,    0.3000,   1.46900,   1.0000E-08, &
     221 40000.000,    0.2500,   1.48400,   1.0000E-08, &
     222 50000.000,    0.2000,   1.49800,   1.0000E-08 /
    161223!---------------------------------------------------------
    162224
    163225  IF (debut) THEN   
     226
    164227  !--initialising dry diameters to geometrically spaced mass/volume (see Jacobson 1994)
    165228      mdw(1)=mdwmin
    … …  
    176239      PRINT *,'init mdw=', mdw
    177240
    178 !$OMP MASTER
    179 
    180 !    CALL gather(tr_seri, tr_seri_glo)
    181 !    IF (is_mpi_root) THEN
    182 !    IF (MAXVAL(tr_seri_glo).LT.1e-30) THEN
    183 
    184241    !--compute particle radius for a composition of 75% H2SO4 / 25% H2O at T=293K
    185242    DO bin_number=1, nbtr_bin
    … …  
    225282      &  lambda_int(NwvmaxSW+nwave_sw+nwave_lw+Nwv)
    226283
    227       OPEN (unit=11,file='h2so4_0.75_300.00_hummel_1988_p_q.dat')
    228 
    229284      IF (refr_ind_interpol) THEN
    230         DO nb=1,nb_lambda_h2so4
    231           READ(11,*) ref_ind(nb,:)
    232         ENDDO
     285
    233286        ilambda_max=ref_ind(1,2)/1.e6 !--in m
    234287        ilambda_min=ref_ind(nb_lambda_h2so4,2)/1.e6 !--in m
    … …  
    259312          ENDIF
    260313        ENDDO
    261       ELSE
    262         DO nb=1,nb_lambda_h2so4
    263           READ(11,*) wavenumber, ilambda, n_r_h2so4, n_i_h2so4
    264           ilambda=1000.*ilambda !wavelength in nm
    265           DO Nwv=1, NwvmaxSW+nwave_sw+nwave_lw+NwvmaxLW
    266             IF (ilambda/1.e9.GT.lambda_int(Nwv)) THEN !--- step function
    267               n_r(Nwv)=n_r_h2so4
    268               n_i(Nwv)=n_i_h2so4
     314
     315      ELSE  !-- no refr_ind_interpol, closest neighbour from upper wavelength
     316
     317        DO Nwv=1, NwvmaxSW+nwave_sw+nwave_lw+NwvmaxLW
     318          n_r(Nwv)=ref_ind(1,3)
     319          n_i(Nwv)=ref_ind(1,4)
     320          DO nb=2,nb_lambda_h2so4
     321            IF (ref_ind(nb,2)/1.e6.GT.lambda_int(Nwv)) THEN !--- step function
     322              n_r(Nwv)=ref_ind(nb,3)
     323              n_i(Nwv)=ref_ind(nb,4)
    269324            ENDIF 
    270325          ENDDO
    271326        ENDDO
    272327      ENDIF
    273       CLOSE(11)
    274328
    275329    !---Loop on wavelengths
    … …  
    400454
    401455      ENDDO  !--loop on wavelength
    402 
    403456
    404457    !---averaging over LMDZ wavebands
    … …  
    491544        piz_bin(nb,bin_number)=ss_w(nb)
    492545        cg_bin(nb,bin_number)=ss_g(nb)
    493 
    494546      ENDDO
    495547
    496548    ENDDO !loop over tracer bins
    497549
    498 !    ENDIF !mpi_root
    499 
    500 !$OMP END MASTER
    501   CALL bcast(alpha_bin)
    502   CALL bcast(piz_bin)
    503   CALL bcast(cg_bin)
    504 !$OMP BARRIER
    505 
    506 !    CALL scatter(alpha_bin, alpha_bin)
    507 !    CALL scatter(piz_bin, piz_bin)
    508 !    CALL scatter(cg_bin, cg_bin)
     550!!$OMP END MASTER
     551!  CALL bcast(alpha_bin)
     552!  CALL bcast(piz_bin)
     553!  CALL bcast(cg_bin)
     554!!$OMP BARRIER
    509555
    510556    !set to default values at first time step (tr_seri still zero)
    … …  
    515561    tau_strat_wave(:,:,:)=1.e-15
    516562
    517   ELSE
    518 
    519 !    CALL gather(tr_seri, tr_seri_glo)
     563  ELSE  !-- not debut
    520564
    521565  !--compute optical properties of actual size distribution (from tr_seri)

  • LMDZ5/trunk/libf/phylmd/StratAer/traccoag_mod.F90

    r2700 r2704  
    7373    REAL,PARAMETER    :: xlat_sai=0.0           ! latitude of SAI in degree
    7474    REAL,PARAMETER    :: xlon_sai=120.35        ! longitude of SAI in degree
    75 
    76 !--be careful - this needs to be changed with resolution - here for 96x95 - seems to work for 48x36 as well
    77     REAL,PARAMETER    :: dlat=0.9474   ! d latitude in degree
    78     REAL,PARAMETER    :: dlon=1.875    ! d longitude in degree
    7975
    8076!--other local variables
    … …  
    9591    REAL                                   :: zdz                 ! thickness of atm. model layer in m
    9692    REAL,DIMENSION(klon,klev)              :: dens_aer            ! density of aerosol particles [kg/m3 aerosol] with default H2SO4 mass fraction
     93    REAL                                   :: dlat, dlon          ! d latitude and d longitude of grid in degree
    9794
    9895    IF (is_mpi_root) THEN
    9996      PRINT *,'in traccoag: date from phys_cal_mod =',year_cur,'-',mth_cur,'-',day_cur,'-',hour
    10097    ENDIF
     98
     99    dlat=180./2./FLOAT(nbp_lat)   ! d latitude in degree
     100    dlon=360./2./FLOAT(nbp_lon)   ! d longitude in degree
    101101
    102102    DO it=1, nbtr_bin
    … …  
    168168        DO i=1,klon
    169169          !Pinatubo eruption at 15.14N, 120.35E
    170           IF  ( xlat(i).GT.xlat_vol-dlat .AND. xlat(i).LT.xlat_vol+dlat .AND. &
    171                 xlon(i).GT.xlon_vol-dlon .AND. xlon(i).LT.xlon_vol+dlon ) THEN
     170          IF  ( xlat(i).GE.xlat_vol-dlat .AND. xlat(i).LT.xlat_vol+dlat .AND. &
     171                xlon(i).GE.xlon_vol-dlon .AND. xlon(i).LT.xlon_vol+dlon ) THEN
    172172!         compute altLMDz
    173173            altLMDz(:)=0.0
    … …  
    209209!       IF  ((mth_cur==4 .AND. &
    210210!       SAI continuous emission o
    211         IF  ( xlat(i).GT.xlat_sai-dlat .AND. xlat(i).LT.xlat_sai+dlat .AND. &
    212           &   xlon(i).GT.xlon_sai-dlon .AND. xlon(i).LT.xlon_sai+dlon ) THEN
     211        IF  ( xlat(i).GE.xlat_sai-dlat .AND. xlat(i).LT.xlat_sai+dlat .AND. &
     212          &   xlon(i).GE.xlon_sai-dlon .AND. xlon(i).LT.xlon_sai+dlon ) THEN
    213213!         compute altLMDz
    214214          altLMDz(:)=0.0

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

    r2702 r2704  
    117117    INTEGER, SAVE       :: iflag_ratqs_omp
    118118
    119     Real, SAVE          :: f_cdrag_ter_omp,f_cdrag_oce_omp
    120     Real, SAVE          :: f_rugoro_omp   , z0min_omp
    121     Real, SAVE          :: z0m_seaice_omp,z0h_seaice_omp
     119    REAL, SAVE          :: f_cdrag_ter_omp,f_cdrag_oce_omp
     120    REAL, SAVE          :: f_rugoro_omp   , z0min_omp
     121    REAL, SAVE          :: z0m_seaice_omp,z0h_seaice_omp
    122122    REAL, SAVE          :: min_wind_speed_omp,f_gust_wk_omp,f_gust_bl_omp,f_qsat_oce_omp, f_z0qh_oce_omp
    123123    INTEGER, SAVE       :: iflag_gusts_omp,iflag_z0_oce_omp
    … …  
    186186    INTEGER,SAVE :: iflag_pbl_split_omp
    187187    INTEGER,SAVE :: iflag_order2_sollw_omp
    188     Integer, SAVE :: lev_histins_omp, lev_histLES_omp
     188    INTEGER, SAVE :: lev_histins_omp, lev_histLES_omp
    189189    INTEGER, SAVE :: lev_histdayNMC_omp
    190190    INTEGER, SAVE :: levout_histNMC_omp(3)

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

    r2690 r2704  
    4141    USE mod_phys_lmdz_para
    4242    USE aero_mod, only : naero_spc,name_aero
    43         !Martin
     43    !Martin
    4444    USE surface_data, ONLY : ok_snow
    4545    USE phys_output_ctrlout_mod
    … …  
    265265         CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
    266266         CALL ymds2ju(annee_ref, 1, day_ini, start_time*rday, zjulian_start)
    267      END IF
     267     ENDIF
    268268
    269269#ifdef CPP_XIOS
    … …  
    293293    WRITE(lunout,*)'Bp Hybrid = ',Bhyb(1:klev)
    294294    WRITE(lunout,*)'Alt approx des couches pour une haut d echelle de 8km = ',Alt(1:klev)
    295     !          endif
     295    !          ENDIF
    296296
    297297  ecrit_files(7) = ecrit_files(1)
    … …  
    302302
    303303       ! Calculate ecrit_files for all files
    304       IF ( chtimestep(iff).eq.'Default' ) then
     304      IF ( chtimestep(iff).eq.'Default' ) THEN
    305305          ! Par defaut ecrit_files = (ecrit_mensuel ecrit_jour ecrit_hf
    306306          ! ...)*86400.
    307307          ecrit_files(iff)=ecrit_files(iff)*86400.
    308       ELSE IF (chtimestep(iff).eq.'-1') then
     308      ELSE IF (chtimestep(iff).eq.'-1') THEN
    309309          PRINT*,'ecrit_files(',iff,') < 0 so IOIPSL work on different'
    310310          PRINT*,'months length'
    311311          ecrit_files(iff)=-1.
    312       else
     312      ELSE
    313313       CALL convers_timesteps(chtimestep(iff),dtime,ecrit_files(iff))
    314314      ENDIF
    … …  
    320320#ifdef CPP_XIOS
    321321!!! Ouverture de chaque fichier XIOS !!!!!!!!!!!
    322     IF (.not. ok_all_xml) then
    323       if (prt_level >= 10) then
     322    IF (.not. ok_all_xml) THEN
     323      IF (prt_level >= 10) THEN
    324324        print*,'phys_output_open: call wxios_add_file with phys_out_filenames(iff)=',trim(phys_out_filenames(iff))   
    325       endif
     325      ENDIF
    326326      CALL wxios_add_file(phys_out_filenames(iff),chtimestep(iff),lev_files(iff)) 
    327327    ENDIF
    328328
    329329!!! Declaration des axes verticaux de chaque fichier:
    330     if (prt_level >= 10) then
     330    IF (prt_level >= 10) THEN
    331331      print*,'phys_output_open: Declare vertical axes for each file'
    332     endif
    333    if (iff.le.6) then
     332    ENDIF
     333   IF (iff.le.6) THEN
    334334    CALL wxios_add_vaxis("presnivs", &
    335335            levmax(iff) - levmin(iff) + 1, presnivs(levmin(iff):levmax(iff)))
    … …  
    340340    CALL wxios_add_vaxis("Alt", &
    341341            levmax(iff) - levmin(iff) + 1, Alt)
    342    else
     342   ELSE
    343343    ! NMC files
    344344    CALL wxios_add_vaxis("plev", &
    345345            levmax(iff) - levmin(iff) + 1, rlevSTD(levmin(iff):levmax(iff)))
    346    endif
     346   ENDIF
    347347#endif
    348348
    … …  
    350350!!!!!!!!!!!!!!!!! Traitement dans le cas ou l'on veut stocker sur un domaine limite !!
    351351!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    352           IF (phys_out_regfkey(iff)) then
     352          IF (phys_out_regfkey(iff)) THEN
    353353             imin_ins=1
    354354             imax_ins=nbp_lon
    … …  
    357357
    358358             ! correction abderr       
    359              do i=1,nbp_lon
     359             DO i=1,nbp_lon
    360360                WRITE(lunout,*)'io_lon(i)=',io_lon(i)
    361361                IF (io_lon(i).le.phys_out_lonmin(iff)) imin_ins=i
    362362                IF (io_lon(i).le.phys_out_lonmax(iff)) imax_ins=i+1
    363              enddo
    364 
    365              do j=1,jjmp1
     363             ENDDO
     364
     365             DO j=1,jjmp1
    366366                WRITE(lunout,*)'io_lat(j)=',io_lat(j)
    367367                IF (io_lat(j).ge.phys_out_latmin(iff)) jmax_ins=j+1
    368368                IF (io_lat(j).ge.phys_out_latmax(iff)) jmin_ins=j
    369              enddo
     369             ENDDO
    370370
    371371             WRITE(lunout,*)'On stoke le fichier histoire numero ',iff,' sur ', &
    … …  
    382382!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    383383             !IM fichiers stations
    384           else IF (clef_stations(iff)) THEN
    385 
    386              if (prt_level >= 10) then
     384          ELSE IF (clef_stations(iff)) THEN
     385
     386             IF (prt_level >= 10) THEN
    387387             WRITE(lunout,*)'phys_output_open: iff=',iff,'  phys_out_filenames(iff)=',phys_out_filenames(iff)
    388              endif
     388             ENDIF
    389389             
    390390             CALL histbeg_phy_all(rlon,rlat,pim,tabij,ipt,jpt,plon,plat,plon_bounds,plat_bounds, &
    391391                  phys_out_filenames(iff), &
    392392                  itau_phy,zjulian,dtime,nhorim(iff),nid_files(iff))
    393           else
     393          ELSE
    394394             CALL histbeg_phy_all(phys_out_filenames(iff),itau_phy,zjulian,&
    395395                 dtime,nhorim(iff),nid_files(iff))
    396           endif
     396          ENDIF
    397397
    398398#ifndef CPP_IOIPSL_NO_OUTPUT
    399           if (iff.le.6) then
     399          IF (iff.le.6) THEN
    400400             CALL histvert(nid_files(iff), "presnivs", "Vertical levels", "Pa", & 
    401401               levmax(iff) - levmin(iff) + 1, &
    … …  
    411411               levmax(iff) - levmin(iff) + 1,Alt,nvertAlt(iff))
    412412
    413           else
     413          ELSE
    414414             CALL histvert(nid_files(iff), "plev", "pressure", "Pa", &
    415415               levmax(iff) - levmin(iff) + 1, &
    416416              rlevSTD(levmin(iff):levmax(iff)), nvertm(iff), "down")
    417           endif
     417          ENDIF
    418418#endif
    419419
    420420     ENDIF ! clef_files
    421421
    422 !CR: ajout d'une variable eau
    423 !      IF (nqtot>=3) THEN
    424 
    425422       IF (nqtot>=nqo+1) THEN
    426 !            DO iq=3,nqtot 
     423!
    427424            DO iq=nqo+1,nqtot
    428425            iiq=niadv(iq)
    … …  
    507504      ENDIF
    508505
    509 
    510506   ENDDO !  iff
    511507
    … …  
    519515    ecrit_ins = ecrit_files(6)
    520516
    521     if (prt_level >= 10) then
     517    IF (prt_level >= 10) THEN
    522518      WRITE(lunout,*)'swaero_diag=',swaero_diag
    523519      WRITE(lunout,*)'phys_output_open: ends here'
    524     endif
    525 
    526   end SUBROUTINE phys_output_open
    527 
    528 
     520    ENDIF
     521
     522  END SUBROUTINE phys_output_open
    529523
    530524  SUBROUTINE convers_timesteps(str,dtime,timestep)
    … …  
    548542    WRITE(lunout,*) "ipos = ", ipos
    549543    WRITE(lunout,*) "il = ", il
    550     if (ipos == 0) call abort_physic("convers_timesteps", "bad str", 1)
     544    IF (ipos == 0) CALL abort_physic("convers_timesteps", "bad str", 1)
    551545    read(str(1:ipos),*) ttt
    552546    WRITE(lunout,*)ttt
    … …  
    554548
    555549
    556     IF ( il == ipos ) then
     550    IF ( il == ipos ) THEN
    557551       type='day'
    558     endif
     552    ENDIF
    559553
    560554    IF ( type == 'day'.or.type == 'days'.or.type == 'jours'.or.type == 'jour' ) timestep = ttt * dayseconde
    561     IF ( type == 'mounths'.or.type == 'mth'.or.type == 'mois' ) then
     555    IF ( type == 'mounths'.or.type == 'mth'.or.type == 'mois' ) THEN
    562556       WRITE(lunout,*)'annee_ref,day_ref mon_len',annee_ref,day_ref,mth_len
    563557       timestep = ttt * dayseconde * mth_len
    564     endif
     558    ENDIF
    565559    IF ( type == 'hours'.or.type == 'hr'.or.type == 'heurs') timestep = ttt * dayseconde / 24.
    566560    IF ( type == 'mn'.or.type == 'minutes'  ) timestep = ttt * 60.
    … …  
    575569
    576570END MODULE phys_output_mod
    577 
    578 

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

    r2690 r2704  
    66  USE phytrac_mod, ONLY : d_tr_cl, d_tr_th, d_tr_cv, d_tr_lessi_impa, &
    77       d_tr_lessi_nucl, d_tr_insc, d_tr_bcscav, d_tr_evapls, d_tr_ls,  &
    8        d_tr_trsp, d_tr_sscav, d_tr_sat, d_tr_uscav
     8       d_tr_trsp, d_tr_sscav, d_tr_sat, d_tr_uscav, flux_tr_dry
    99
    1010  ! Author: Abderrahmane IDELKADI (original include file)
    … …  
    2424    ! defined and initialised in phys_output_mod.F90
    2525
    26     USE dimphy, only: klon, klev, klevp1
     26    USE dimphy, ONLY: klon, klev, klevp1
     27    USE infotrac, ONLY: nbtr
    2728    USE mod_phys_lmdz_para, ONLY: is_north_pole_phy,is_south_pole_phy
    2829    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
    29     USE time_phylmdz_mod, only: day_step_phy, start_time, itau_phy
    30     USE phys_output_ctrlout_mod, only: o_phis, o_aire, is_ter, is_lic, is_oce, &
     30    USE time_phylmdz_mod, ONLY: day_step_phy, start_time, itau_phy
     31    USE phys_output_ctrlout_mod, ONLY: o_phis, o_aire, is_ter, is_lic, is_oce, &
    3132         is_ave, is_sic, o_contfracATM, o_contfracOR, &
    3233         o_aireTER, o_flat, o_slp, o_ptstar, o_pt0, o_tsol, &
    … …  
    163164         o_dtr_lessi_impa, o_dtr_lessi_nucl, &
    164165         o_dtr_insc, o_dtr_bcscav, o_dtr_evapls, &
    165          o_dtr_ls, o_dtr_trsp, o_dtr_sscav, &
     166         o_dtr_ls, o_dtr_trsp, o_dtr_sscav, o_dtr_dry, &
    166167         o_dtr_sat, o_dtr_uscav, o_trac_cum, o_du_gwd_rando, o_dv_gwd_rando, &
    167168         o_ustr_gwd_hines,o_vstr_gwd_hines,o_ustr_gwd_rando,o_vstr_gwd_rando, &
    … …  
    183184
    184185#ifdef CPP_StratAer
    185     USE phys_output_ctrlout_mod, only:  &
     186    USE phys_output_ctrlout_mod, ONLY:  &
    186187         o_sulf_convert, o_sulf_nucl, o_sulf_cond_evap, o_ocs_convert, &
    187188         o_sfluxaer, o_R2SO4, o_OCS_lifetime, o_SO2_lifetime, &
    … …  
    191192#endif
    192193
    193     USE phys_state_var_mod, only: pctsrf, paire_ter, rain_fall, snow_fall, &
     194    USE phys_state_var_mod, ONLY: pctsrf, paire_ter, rain_fall, snow_fall, &
    194195         qsol, z0m, z0h, fevap, agesno, &
    195196         nday_rain, rain_con, snow_con, &
    … …  
    218219         vphiSTD, wTSTD, u2STD, v2STD, T2STD, missing_val_nf90
    219220
    220     USE phys_local_var_mod, only: zxfluxlat, slp, ptstar, pt0, zxtsol, zt2m, &
     221    USE phys_local_var_mod, ONLY: zxfluxlat, slp, ptstar, pt0, zxtsol, zt2m, &
    221222         t2m_min_mon, t2m_max_mon, evap, &
    222223         l_mixmin,l_mix, &
    … …  
    282283
    283284#ifdef CPP_StratAer
    284     USE phys_local_var_mod, only:  &
     285    USE phys_local_var_mod, ONLY:  &
    285286         sulf_convert, sulf_nucl, sulf_cond_evap, ocs_convert, &
    286287         sfluxaer, R2SO4, OCS_lifetime, SO2_lifetime, &
    … …  
    290291#endif
    291292
    292     USE phys_output_var_mod, only: vars_defined, snow_o, zfra_o, bils_diss, &
     293    USE phys_output_var_mod, ONLY: vars_defined, snow_o, zfra_o, bils_diss, &
    293294         bils_ec,bils_ech, bils_tke, bils_kinetic, bils_latent, bils_enthalp, &
    294295         itau_con, nfiles, clef_files, nid_files, &
    … …  
    309310         alt_tropo
    310311
    311     USE ocean_slab_mod, only: nslay, tslab, slab_bils, slab_bilg, tice, &
     312    USE ocean_slab_mod, ONLY: nslay, tslab, slab_bils, slab_bilg, tice, &
    312313        seaice, slab_ekman,slab_hdiff, dt_ekman, dt_hdiff
    313     USE pbl_surface_mod, only: snow
    314     USE indice_sol_mod, only: nbsrf
    315     USE infotrac_phy, only: nqtot, nqo, type_trac
    316     USE geometry_mod, only: cell_area
    317     USE surface_data, only: type_ocean, version_ocean, ok_veget, ok_snow
    318 !    USE aero_mod, only: naero_spc
    319     USE aero_mod, only: naero_tot, id_STRAT_phy
    320     USE ioipsl, only: histend, histsync
    321     USE iophy, only: set_itau_iophy, histwrite_phy
    322     USE netcdf, only: nf90_fill_real
     314    USE pbl_surface_mod, ONLY: snow
     315    USE indice_sol_mod, ONLY: nbsrf
     316    USE infotrac_phy, ONLY: nqtot, nqo, type_trac, tname, niadv
     317    USE geometry_mod, ONLY: cell_area
     318    USE surface_data, ONLY: type_ocean, version_ocean, ok_veget, ok_snow
     319!    USE aero_mod, ONLY: naero_spc
     320    USE aero_mod, ONLY: naero_tot, id_STRAT_phy
     321    USE ioipsl, ONLY: histend, histsync
     322    USE iophy, ONLY: set_itau_iophy, histwrite_phy
     323    USE netcdf, ONLY: nf90_fill_real
    323324    USE print_control_mod, ONLY: prt_level,lunout
    324325
    … …  
    326327#ifdef CPP_XIOS
    327328    ! ug Pour les sorties XIOS
    328     USE xios, ONLY: xios_update_calendar
    329     USE wxios, only: wxios_closedef, missing_val
    330 #endif
    331     USE phys_cal_mod, only : mth_len
     329    USE xios
     330    USE wxios, ONLY: wxios_closedef, missing_val
     331#endif
     332    USE phys_cal_mod, ONLY : mth_len
    332333
    333334#ifdef CPP_RRTM
    … …  
    336337
    337338    IMPLICIT NONE
    338 
    339339
    340340    INCLUDE "clesphys.h"
    … …  
    364364    ! Local
    365365    INTEGER :: itau_w
    366     INTEGER :: i, iinit, iinitend=1, iff, iq, nsrf, k, ll, naero
     366    INTEGER :: i, iinit, iinitend=1, iff, iq, iiq, nsrf, k, ll, naero
    367367    REAL, DIMENSION (klon) :: zx_tmp_fi2d
    368368    REAL, DIMENSION (klon,klev) :: zx_tmp_fi3d, zpt_conv
    … …  
    379379    INTEGER ISW
    380380    CHARACTER*1 ch1
     381    CHARACTER*20 varname
     382
     383#ifdef CPP_XIOS
     384    TYPE(xios_fieldgroup) :: group_handle
     385    TYPE(xios_field) :: child
     386#endif
    381387
    382388    ! On calcul le nouveau tau:
    … …  
    390396       iinitend = 1
    391397    ENDIF
     398
     399#ifdef CPP_XIOS
     400#ifdef CPP_StratAer
     401    IF (.NOT.vars_defined) THEN
     402          !On ajoute les variables 3D traceurs par l interface fortran
     403          CALL xios_get_handle("fields_strataer_trac_3D", group_handle)
     404          ! On boucle sur les traceurs pour les ajouter au groupe puis fixer les attributs
     405          DO iq=nqo+1, nqtot
     406            iiq=niadv(iq)
     407            varname=trim(tname(iiq))
     408            WRITE (lunout,*) 'XIOS var=', nqo, iq, varname
     409            CALL xios_add_child(group_handle, child, varname)
     410            CALL xios_set_attr(child, name=varname, unit="kg kg-1")
     411            varname='d'//trim(tname(iiq))//'_vdf'
     412            CALL xios_add_child(group_handle, child, varname)
     413            CALL xios_set_attr(child, name=varname, unit="kg kg-1 s-1")
     414            varname='d'//trim(tname(iiq))//'_the'
     415            CALL xios_add_child(group_handle, child, varname)
     416            CALL xios_set_attr(child, name=varname, unit="kg kg-1 s-1")
     417            varname='d'//trim(tname(iiq))//'_con'
     418            CALL xios_add_child(group_handle, child, varname)
     419            CALL xios_set_attr(child, name=varname, unit="kg kg-1 s-1")
     420            varname='d'//trim(tname(iiq))//'_lessi_impa'
     421            CALL xios_add_child(group_handle, child, varname)
     422            CALL xios_set_attr(child, name=varname, unit="kg kg-1 s-1")
     423            varname='d'//trim(tname(iiq))//'_lessi_nucl'
     424            CALL xios_add_child(group_handle, child, varname)
     425            CALL xios_set_attr(child, name=varname, unit="kg kg-1 s-1")
     426            varname='d'//trim(tname(iiq))//'_insc'
     427            CALL xios_add_child(group_handle, child, varname)
     428            CALL xios_set_attr(child, name=varname, unit="kg kg-1 s-1")
     429            varname='d'//trim(tname(iiq))//'_bcscav'
     430            CALL xios_add_child(group_handle, child, varname)
     431            CALL xios_set_attr(child, name=varname, unit="kg kg-1 s-1")
     432            varname='d'//trim(tname(iiq))//'_evapls'
     433            CALL xios_add_child(group_handle, child, varname)
     434            CALL xios_set_attr(child, name=varname, unit="kg kg-1 s-1")
     435            varname='d'//trim(tname(iiq))//'_ls'
     436            CALL xios_add_child(group_handle, child, varname)
     437            CALL xios_set_attr(child, name=varname, unit="kg kg-1 s-1")
     438            varname='d'//trim(tname(iiq))//'_trsp'
     439            CALL xios_add_child(group_handle, child, varname)
     440            CALL xios_set_attr(child, name=varname, unit="kg kg-1 s-1")
     441            varname='d'//trim(tname(iiq))//'_sscav'
     442            CALL xios_add_child(group_handle, child, varname)
     443            CALL xios_set_attr(child, name=varname, unit="kg kg-1 s-1")
     444            varname='d'//trim(tname(iiq))//'_sat'
     445            CALL xios_add_child(group_handle, child, varname)
     446            CALL xios_set_attr(child, name=varname, unit="kg kg-1 s-1")
     447            varname='d'//trim(tname(iiq))//'_uscav'
     448            CALL xios_add_child(group_handle, child, varname)
     449            CALL xios_set_attr(child, name=varname, unit="kg kg-1 s-1")
     450          ENDDO
     451          !On ajoute les variables 2D traceurs par l interface fortran
     452          CALL xios_get_handle("fields_strataer_trac_2D", group_handle)
     453          ! On boucle sur les traceurs pour les ajouter au groupe puis fixer les attributs
     454          DO iq=nqo+1, nqtot
     455            iiq=niadv(iq)
     456            varname='cum'//trim(tname(iiq))
     457            WRITE (lunout,*) 'XIOS var=', iq, varname
     458            CALL xios_add_child(group_handle, child, varname)
     459            CALL xios_set_attr(child, name=varname, unit="kg m-2")
     460            varname='cumd'//trim(tname(iiq))//'_dry'
     461            CALL xios_add_child(group_handle, child, varname)
     462            CALL xios_set_attr(child, name=varname, unit="kg m-2 s-1")
     463          ENDDO
     464    ENDIF
     465#endif
     466#endif
    392467
    393468    ! ug la boucle qui suit ne sert qu'une fois, pour l'initialisation, sinon il n'y a toujours qu'un seul passage:
    … …  
    17851860#endif
    17861861!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    1787         IF (nqtot.GE.nqo+1) THEN
    1788           DO iq=nqo+1,nqtot
     1862       IF (nqtot.GE.nqo+1) THEN
     1863          DO iq=nqo+1, nqtot
    17891864            IF (type_trac == 'lmdz' .OR. type_trac == 'repr' .OR. type_trac == 'coag') THEN
     1865             !--3D fields
    17901866             CALL histwrite_phy(o_trac(iq-nqo), tr_seri(:,:,iq-nqo))
    17911867             CALL histwrite_phy(o_dtr_vdf(iq-nqo),d_tr_cl(:,:,iq-nqo))
    … …  
    18021878             CALL histwrite_phy(o_dtr_sat(iq-nqo),d_tr_sat(:,:,iq-nqo))
    18031879             CALL histwrite_phy(o_dtr_uscav(iq-nqo),d_tr_uscav(:,:,iq-nqo))
     1880             !--2D fields
     1881             CALL histwrite_phy(o_dtr_dry(iq-nqo), flux_tr_dry(:,iq-nqo))
    18041882             zx_tmp_fi2d=0.
    18051883             IF (vars_defined) THEN
    … …  
    18211899                ndex2d = 0
    18221900                ndex3d = 0
    1823 
    18241901             ENDIF ! clef_files
    18251902          ENDDO !  iff
    … …  
    18321909          !$OMP BARRIER
    18331910          vars_defined = .TRUE.
    1834        ENDIF
     1911
     1912       ENDIF !--.NOT.vars_defined
    18351913
    18361914    ENDDO
Note: See TracChangeset for help on using the changeset viewer.