Ignore:
Timestamp:
Apr 14, 2017, 4:42:31 PM (7 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

File:
1 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
Note: See TracChangeset for help on using the changeset viewer.