Ignore:
Timestamp:
Nov 5, 2018, 3:24:59 PM (6 years ago)
Author:
Laurent Fairhead
Message:

Undoing merge with trunk (r3356) to properly register Yann's latest modifications

Location:
LMDZ6/branches/DYNAMICO-conv
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/DYNAMICO-conv

  • LMDZ6/branches/DYNAMICO-conv/libf/phylmd/iophy.F90

    r3356 r3411  
    1212  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: nptabij
    1313  INTEGER, SAVE :: itau_iophy
    14   LOGICAL :: check_dim = .false.
    1514
    1615!$OMP THREADPRIVATE(itau_iophy)
    … …  
    3534! ug Routine pour définir itau_iophy depuis phys_output_write_mod:
    3635  SUBROUTINE set_itau_iophy(ito)
    37     IMPLICIT NONE
    38     INTEGER, INTENT(IN) :: ito
    39     itau_iophy = ito
     36      IMPLICIT NONE
     37      INTEGER, INTENT(IN) :: ito
     38      itau_iophy = ito
    4039  END SUBROUTINE
    4140
    4241  SUBROUTINE init_iophy_new(rlat,rlon)
    43 
    44     USE dimphy, ONLY: klon
    45     USE mod_phys_lmdz_para, ONLY: gather, bcast, &
    46                                   jj_nb, jj_begin, jj_end, ii_begin, ii_end, &
    47                                   mpi_size, mpi_rank, klon_mpi, &
     42  USE dimphy, ONLY: klon
     43  USE mod_phys_lmdz_para, ONLY: gather, bcast, &
     44                                jj_nb, jj_begin, jj_end, ii_begin, ii_end, &
     45                                mpi_size, mpi_rank, klon_mpi, &
    4846                                is_sequential, is_south_pole_dyn
    4947  USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, grid_type, unstructured
    5048  USE print_control_mod, ONLY: prt_level,lunout
    5149#ifdef CPP_IOIPSL
    52     USE ioipsl, ONLY: flio_dom_set
     50  USE ioipsl, ONLY: flio_dom_set
    5351#endif
    5452#ifdef CPP_XIOS
    5553  use wxios, ONLY: wxios_domain_param, wxios_domain_param_unstructured, wxios_context_init
    56     USE wxios, ONLY: wxios_domain_param
    57 #endif
    58     IMPLICIT NONE
     54#endif
     55  IMPLICIT NONE
    5956    REAL,DIMENSION(klon),INTENT(IN) :: rlon
    6057    REAL,DIMENSION(klon),INTENT(IN) :: rlat
    … …  
    175172  END SUBROUTINE init_iophy_new
    176173
    177 
    178174  SUBROUTINE init_iophy(lat,lon)
    179 
    180     USE mod_phys_lmdz_para, ONLY: jj_begin, jj_end, ii_begin, ii_end, jj_nb, &
    181                                   mpi_size, mpi_rank
    182     USE ioipsl, ONLY: flio_dom_set
    183     USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
    184 
    185     IMPLICIT NONE
    186 
     175  USE mod_phys_lmdz_para, ONLY: jj_begin, jj_end, ii_begin, ii_end, jj_nb, &
     176                                mpi_size, mpi_rank
     177  USE ioipsl, ONLY: flio_dom_set
     178  USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
     179  IMPLICIT NONE
    187180    REAL,DIMENSION(nbp_lon),INTENT(IN) :: lon
    188181    REAL,DIMENSION(nbp_lat),INTENT(IN) :: lat
    … …  
    232225#endif
    233226  IMPLICIT NONE
    234   INCLUDE 'clesphys.h'
    235    
    236   CHARACTER*(*), INTENT(IN) :: name
    237   INTEGER, INTENT(IN) :: itau0
    238   REAL,INTENT(IN) :: zjulian
    239   REAL,INTENT(IN) :: dtime
    240   CHARACTER(LEN=*), INTENT(IN) :: ffreq
    241   INTEGER,INTENT(IN) :: lev
    242   INTEGER,INTENT(OUT) :: nhori
    243   INTEGER,INTENT(OUT) :: nid_day
     227  include 'clesphys.h'
     228   
     229    CHARACTER*(*), INTENT(IN) :: name
     230    INTEGER, INTENT(IN) :: itau0
     231    REAL,INTENT(IN) :: zjulian
     232    REAL,INTENT(IN) :: dtime
     233    CHARACTER(LEN=*), INTENT(IN) :: ffreq
     234    INTEGER,INTENT(IN) :: lev
     235    INTEGER,INTENT(OUT) :: nhori
     236    INTEGER,INTENT(OUT) :: nid_day
    244237
    245238!$OMP MASTER   
    246   IF (is_sequential) THEN
    247     CALL histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
    248                  1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day)
    249   ELSE
    250     CALL histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
    251                  1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day,phys_domain_id)
    252   ENDIF
    253 
    254 #ifdef CPP_XIOS
    255   ! ug OMP en chantier...
    256   IF((.NOT. is_using_mpi) .OR. is_mpi_root) THEN
    257       ! ug Création du fichier
    258     IF (.not. ok_all_xml) THEN
    259       CALL wxios_add_file(name, ffreq, lev)
    260     ENDIF
    261   ENDIF
     239    IF (is_sequential) THEN
     240      call histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
     241                   1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day)
     242    ELSE
     243      call histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
     244                   1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day,phys_domain_id)
     245    ENDIF
     246
     247#ifdef CPP_XIOS
     248    ! ug OMP en chantier...
     249    IF((.NOT. is_using_mpi) .OR. is_mpi_root) THEN
     250        ! ug Création du fichier
     251      IF (.not. ok_all_xml) THEN
     252        CALL wxios_add_file(name, ffreq, lev)
     253      ENDIF
     254    ENDIF
    262255#endif
    263256!$OMP END MASTER
    … …  
    283276#ifndef CPP_IOIPSL_NO_OUTPUT
    284277    IF (is_sequential) THEN
    285       CALL histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
     278      call histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
    286279                   1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day)
    287280    ELSE
    288       CALL histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
     281      call histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
    289282                   1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day,phys_domain_id)
    290283    ENDIF
    … …  
    420413
    421414#ifndef CPP_IOIPSL_NO_OUTPUT
    422      CALL histbeg(nname,pim,plon,plon_bounds, &
     415     call histbeg(nname,pim,plon,plon_bounds, &
    423416                           plat,plat_bounds, &
    424417                           itau0, zjulian, dtime, nnhori, nnid_day)
    … …  
    461454     ENDDO
    462455#ifndef CPP_IOIPSL_NO_OUTPUT
    463      CALL histbeg(nname,npstn,npplon,npplon_bounds, &
     456     call histbeg(nname,npstn,npplon,npplon_bounds, &
    464457                            npplat,npplat_bounds, &
    465458                            itau0,zjulian,dtime,nnhori,nnid_day,phys_domain_id)
    … …  
    474467
    475468    USE ioipsl, ONLY: histdef
    476     USE mod_phys_lmdz_para, ONLY: jj_nb, is_master
     469    USE mod_phys_lmdz_para, ONLY: jj_nb
    477470    USE phys_output_var_mod, ONLY: type_ecri, zoutm, zdtime_moy, lev_files, &
    478471                                   nid_files, nhorim, swaero_diag, dryaod_diag, nfiles, &
    … …  
    480473    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
    481474    USE aero_mod, ONLY : naero_tot, name_aero_tau
    482     USE print_control_mod, ONLY: prt_level,lunout
    483475
    484476    IMPLICIT NONE
    … …  
    501493       zstophym=zdtime_moy
    502494    ENDIF
    503     IF (check_dim .AND. is_master) WRITE(lunout,*)'histdef2d_old for ', nomvar
     495
    504496    ! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def
    505497    CALL conf_physoutputs(nomvar,flag_var)
    … …  
    551543    USE ioipsl, ONLY: histdef
    552544    USE dimphy, ONLY: klev
    553     USE mod_phys_lmdz_para, ONLY: jj_nb, is_master
     545    USE mod_phys_lmdz_para, ONLY: jj_nb
    554546    USE phys_output_var_mod, ONLY: type_ecri, zoutm, lev_files, nid_files, &
    555547                                   nhorim, zdtime_moy, levmin, levmax, &
    556548                                   nvertm, nfiles
    557549    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
    558     USE print_control_mod, ONLY: prt_level,lunout
    559550    IMPLICIT NONE
    560551
    … …  
    572563    ! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def
    573564    CALL conf_physoutputs(nomvar,flag_var)
    574 
    575     IF (check_dim .AND. is_master) WRITE(lunout,*)'histdef3d_old for ', nomvar
    576565
    577566    IF (type_ecri(iff)=='inst(X)'.OR.type_ecri(iff)=='once') THEN
    … …  
    601590
    602591    USE ioipsl, ONLY: histdef
    603     USE mod_phys_lmdz_para, ONLY: jj_nb, is_master
     592    USE mod_phys_lmdz_para, ONLY: jj_nb
    604593    USE phys_output_var_mod, ONLY: ctrl_out, type_ecri_files, zoutm, zdtime_moy, &
    605594                                   clef_stations, phys_out_filenames, lev_files, &
    606                                    nid_files, nhorim, swaerofree_diag, swaero_diag, dryaod_diag,&
     595                                   nid_files, nhorim, swaero_diag, dryaod_diag,&
    607596                                   ok_4xCO2atm
    608597    USE print_control_mod, ONLY: prt_level,lunout
    … …  
    612601    USE wxios, ONLY: wxios_add_field_to_file
    613602#endif
    614     USE print_control_mod, ONLY: prt_level,lunout
    615603    IMPLICIT NONE
    616604
    … …  
    623611    REAL zstophym
    624612    CHARACTER(LEN=20) :: typeecrit
    625 
    626     IF (check_dim .AND. is_master) WRITE(lunout,*)'histdef2d for ', var%name
    627613
    628614    ! ug On récupère le type écrit de la structure:
    … …  
    686672         var%name=='toplwai' .OR. var%name=='sollwai'  ) ) ) THEN
    687673       IF  ( var%flag(iff)<=lev_files(iff) ) swaero_diag=.TRUE.
    688     ENDIF
    689 
    690     ! Set swaerofree_diag=true if at least one of the concerned variables are defined
    691     IF (var%name=='SWupTOAcleanclr' .OR. var%name=='SWupSFCcleanclr' .OR. var%name=='SWdnSFCcleanclr' .OR. &
    692         var%name=='LWupTOAcleanclr' .OR. var%name=='LWdnSFCcleanclr' ) THEN
    693        IF  ( var%flag(iff)<=lev_files(iff) ) swaerofree_diag=.TRUE.
    694674    ENDIF
    695675
    … …  
    719699    USE ioipsl, ONLY: histdef
    720700    USE dimphy, ONLY: klev
    721     USE mod_phys_lmdz_para, ONLY: jj_nb, is_master
     701    USE mod_phys_lmdz_para, ONLY: jj_nb
    722702    USE phys_output_var_mod, ONLY: ctrl_out, type_ecri_files, zoutm, zdtime_moy, &
    723703                                   clef_stations, phys_out_filenames, lev_files, &
    724                                    nid_files, nhorim, swaerofree_diag, levmin, &
     704                                   nid_files, nhorim, swaero_diag, dryaod_diag, levmin, &
    725705                                   levmax, nvertm
    726706    USE print_control_mod, ONLY: prt_level,lunout
    … …  
    729709    USE wxios, ONLY: wxios_add_field_to_file
    730710#endif
    731     USE print_control_mod, ONLY: prt_level,lunout
    732711    IMPLICIT NONE
    733712
    … …  
    739718    REAL zstophym
    740719    CHARACTER(LEN=20) :: typeecrit
    741 
    742     IF (check_dim .AND. is_master) WRITE(lunout,*)'histdef3d for ', var%name
    743720
    744721    ! ug On récupère le type écrit de la structure:
    … …  
    756733    ENDIF
    757734
     735
    758736    ! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def
    759737    CALL conf_physoutputs(var%name,var%flag)
    … …  
    796774#endif
    797775    ENDIF
    798 
    799     ! Set swaerofree_diag=true if at least one of the concerned variables are defined
    800     IF (var%name=='rsucsaf' .OR. var%name=='rsdcsaf') THEN
    801        IF  ( var%flag(iff)<=lev_files(iff) ) swaerofree_diag=.TRUE.
    802     ENDIF
    803 
    804776  END SUBROUTINE histdef3d
    805777
    … …  
    824796 
    825797  SUBROUTINE histwrite2d_phy_old(nid,lpoint,name,itau,field)
    826 
    827     USE dimphy, ONLY: klon
    828     USE mod_phys_lmdz_para, ONLY: Gather_omp, grid1Dto2D_mpi, &
    829                                   is_sequential, klon_mpi_begin, klon_mpi_end, &
    830                                   jj_nb, klon_mpi, is_master
    831     USE ioipsl, ONLY: histwrite
    832     USE print_control_mod, ONLY: prt_level,lunout
    833     USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
    834 
    835     IMPLICIT NONE
     798  USE dimphy, ONLY: klon
     799  USE mod_phys_lmdz_para, ONLY: Gather_omp, grid1Dto2D_mpi, &
     800                                is_sequential, klon_mpi_begin, klon_mpi_end, &
     801                                jj_nb, klon_mpi
     802  USE ioipsl, ONLY: histwrite
     803  USE print_control_mod, ONLY: prt_level,lunout
     804  USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
     805  IMPLICIT NONE
    836806   
    837807    INTEGER,INTENT(IN) :: nid
    … …  
    848818
    849819    IF (size(field)/=klon) CALL abort_physic('iophy::histwrite2d','Field first DIMENSION not equal to klon',1)
    850     IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite2d_phy_old for ', name
    851 
     820   
    852821    CALL Gather_omp(field,buffer_omp)   
    853822!$OMP MASTER
    854823    CALL grid1Dto2D_mpi(buffer_omp,Field2d)
    855     IF (.NOT.lpoint) THEN
     824    if(.NOT.lpoint) THEN
    856825     ALLOCATE(index2d(nbp_lon*jj_nb))
    857826     ALLOCATE(fieldok(nbp_lon*jj_nb))
    … …  
    891860
    892861  SUBROUTINE histwrite3d_phy_old(nid,lpoint,name,itau,field)
    893 
    894     USE dimphy, ONLY: klon
    895     USE mod_phys_lmdz_para, ONLY: Gather_omp, grid1Dto2D_mpi, &
    896                                   is_sequential, klon_mpi_begin, klon_mpi_end, &
    897                                   jj_nb, klon_mpi, is_master
    898     USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
    899     USE ioipsl, ONLY: histwrite
    900     USE print_control_mod, ONLY: prt_level,lunout
    901 
    902     IMPLICIT NONE
     862  USE dimphy, ONLY: klon
     863  USE mod_phys_lmdz_para, ONLY: Gather_omp, grid1Dto2D_mpi, &
     864                                is_sequential, klon_mpi_begin, klon_mpi_end, &
     865                                jj_nb, klon_mpi
     866  USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
     867  USE ioipsl, ONLY: histwrite
     868  USE print_control_mod, ONLY: prt_level,lunout
     869  IMPLICIT NONE
    903870   
    904871    INTEGER,INTENT(IN) :: nid
    … …  
    913880    REAL,allocatable, DIMENSION(:,:) :: fieldok
    914881
    915     IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite3d_phy_old for ', name
    916882
    917883    IF (size(field,1)/=klon) CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)
    … …  
    922888    CALL grid1Dto2D_mpi(buffer_omp,field3d)
    923889    IF (.NOT.lpoint) THEN
    924       ALLOCATE(index3d(nbp_lon*jj_nb*nlev))
    925       ALLOCATE(fieldok(nbp_lon*jj_nb,nlev))
    926       IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL'
    927       CALL histwrite(nid,name,itau,Field3d,nbp_lon*jj_nb*nlev,index3d)
    928       IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
    929     ELSE
     890     ALLOCATE(index3d(nbp_lon*jj_nb*nlev))
     891     ALLOCATE(fieldok(nbp_lon*jj_nb,nlev))
     892     IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL'
     893     CALL histwrite(nid,name,itau,Field3d,nbp_lon*jj_nb*nlev,index3d)
     894     IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
     895   ELSE
    930896      nlev=size(field,2)
    931897      ALLOCATE(index3d(npstn*nlev))
    … …  
    933899
    934900      IF (is_sequential) THEN
    935 !       klon_mpi_begin=1
    936 !       klon_mpi_end=klon
    937         DO n=1, nlev
    938         DO ip=1, npstn
    939           fieldok(ip,n)=buffer_omp(nptabij(ip),n)
    940         ENDDO
    941         ENDDO
     901!      klon_mpi_begin=1
     902!      klon_mpi_end=klon
     903       DO n=1, nlev
     904       DO ip=1, npstn
     905        fieldok(ip,n)=buffer_omp(nptabij(ip),n)
     906       ENDDO
     907       ENDDO
    942908      ELSE
    943         DO n=1, nlev
    944         DO ip=1, npstn
    945           IF(nptabij(ip).GE.klon_mpi_begin.AND. &
    946            nptabij(ip).LE.klon_mpi_end) THEN
    947            fieldok(ip,n)=buffer_omp(nptabij(ip)-klon_mpi_begin+1,n)
    948           ENDIF
    949         ENDDO
    950         ENDDO
     909       DO n=1, nlev
     910       DO ip=1, npstn
     911        IF(nptabij(ip).GE.klon_mpi_begin.AND. &
     912         nptabij(ip).LE.klon_mpi_end) THEN
     913         fieldok(ip,n)=buffer_omp(nptabij(ip)-klon_mpi_begin+1,n)
     914        ENDIF
     915       ENDDO
     916       ENDDO
    951917      ENDIF
    952918      IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL'
    … …  
    954920      IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
    955921    ENDIF
    956     DEALLOCATE(index3d)
    957     DEALLOCATE(fieldok)
     922  DEALLOCATE(index3d)
     923  DEALLOCATE(fieldok)
    958924!$OMP END MASTER   
    959925
    960926  END SUBROUTINE histwrite3d_phy_old
     927
     928
    961929
    962930
    963931! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
    964932  SUBROUTINE histwrite2d_phy(var,field, STD_iff)
    965 
    966   USE mod_phys_lmdz_omp_transfert, ONLY: bcast_omp
    967933  USE dimphy, ONLY: klon, klev
    968934  USE mod_phys_lmdz_para, ONLY: gather_omp, grid1dto2d_mpi, &
    969935                                jj_nb, klon_mpi, klon_mpi_begin, &
    970                                 klon_mpi_end, is_sequential, is_master
     936                                klon_mpi_end, is_sequential
    971937  USE ioipsl, ONLY: histwrite
    972938  USE phys_output_var_mod, ONLY: ctrl_out, clef_files, lev_files, &
    973939                                 nfiles, vars_defined, clef_stations, &
    974                                  nid_files, swaerofree_diag, swaero_diag, dryaod_diag, ok_4xCO2atm
     940                                 nid_files
    975941  USE print_control_mod, ONLY: prt_level,lunout
    976942  USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, unstructured, regular_lonlat
    … …  
    981947
    982948  IMPLICIT NONE
    983   INCLUDE 'clesphys.h'
    984 
    985   TYPE(ctrl_out), INTENT(IN) :: var
    986   REAL, DIMENSION(:), INTENT(IN) :: field
    987   INTEGER, INTENT(IN), OPTIONAL :: STD_iff ! ug RUSTINE POUR LES STD LEVS.....
     949  include 'clesphys.h'
     950
     951    TYPE(ctrl_out), INTENT(IN) :: var
     952    REAL, DIMENSION(:), INTENT(IN) :: field
     953    INTEGER, INTENT(IN), OPTIONAL :: STD_iff ! ug RUSTINE POUR LES STD LEVS.....
    988954     
    989   INTEGER :: iff, iff_beg, iff_end
    990   LOGICAL, SAVE  :: firstx
     955    INTEGER :: iff, iff_beg, iff_end
     956    LOGICAL, SAVE  :: firstx
    991957!$OMP THREADPRIVATE(firstx)
    992958
    993   REAL,DIMENSION(klon_mpi) :: buffer_omp
    994   INTEGER, allocatable, DIMENSION(:) :: index2d
    995   REAL :: Field2d(nbp_lon,jj_nb)
    996 
    997   INTEGER :: ip
    998   REAL, ALLOCATABLE, DIMENSION(:) :: fieldok
    999 
    1000   IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite2d_phy for ',trim(var%name)
    1001 
    1002   IF (prt_level >= 10) THEN
    1003     WRITE(lunout,*)'Begin histwrite2d_phy for ',trim(var%name)
    1004   ENDIF
    1005 
     959    REAL,DIMENSION(klon_mpi) :: buffer_omp
     960    INTEGER, allocatable, DIMENSION(:) :: index2d
     961    REAL :: Field2d(nbp_lon,jj_nb)
     962
     963    INTEGER :: ip
     964    REAL, ALLOCATABLE, DIMENSION(:) :: fieldok
     965
     966    IF (prt_level >= 10) THEN
     967      WRITE(lunout,*)'Begin histwrite2d_phy for ',trim(var%name)
     968    ENDIF
    1006969! ug RUSTINE POUR LES STD LEVS.....
    1007   IF (PRESENT(STD_iff)) THEN
    1008         iff_beg = STD_iff
    1009         iff_end = STD_iff
    1010   ELSE
    1011         iff_beg = 1
    1012         iff_end = nfiles
    1013   ENDIF
     970      IF (PRESENT(STD_iff)) THEN
     971            iff_beg = STD_iff
     972            iff_end = STD_iff
     973      ELSE
     974            iff_beg = 1
     975            iff_end = nfiles
     976      ENDIF
    1014977
    1015978  ! On regarde si on est dans la phase de définition ou d'écriture:
    … …  
    1029992      ENDIF
    1030993!$OMP END MASTER
    1031 !--broadcasting the flags that have been changed in histdef2d on OMP masters
    1032       CALL bcast_omp(swaero_diag)
    1033       CALL bcast_omp(swaerofree_diag)
    1034       CALL bcast_omp(dryaod_diag)
    1035       CALL bcast_omp(ok_4xCO2atm)
    1036 
    1037994  ELSE
    1038995
    … …  
    11481105!$OMP END MASTER   
    11491106  ENDIF ! vars_defined
    1150 
    11511107  IF (prt_level >= 10) WRITE(lunout,*)'End histwrite2d_phy ',trim(var%name)
    1152 
    11531108  END SUBROUTINE histwrite2d_phy
    11541109
    … …  
    11561111! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
    11571112  SUBROUTINE histwrite3d_phy(var, field, STD_iff)
    1158 
    1159   USE mod_phys_lmdz_omp_transfert, ONLY: bcast_omp
    11601113  USE dimphy, ONLY: klon, klev
    11611114  USE mod_phys_lmdz_para, ONLY: gather_omp, grid1dto2d_mpi, &
    11621115                                jj_nb, klon_mpi, klon_mpi_begin, &
    1163                                 klon_mpi_end, is_sequential, is_master
     1116                                klon_mpi_end, is_sequential
    11641117  USE ioipsl, ONLY: histwrite
    11651118  USE phys_output_var_mod, ONLY: ctrl_out, clef_files, lev_files, &
    11661119                                 nfiles, vars_defined, clef_stations, &
    1167                                  nid_files, swaerofree_diag
     1120                                 nid_files
    11681121  USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, regular_lonlat, unstructured
    11691122#ifdef CPP_XIOS
    … …  
    11731126
    11741127  IMPLICIT NONE
    1175   INCLUDE 'clesphys.h'
    1176 
    1177   TYPE(ctrl_out), INTENT(IN) :: var
    1178   REAL, DIMENSION(:,:), INTENT(IN) :: field ! --> field(klon,:)
    1179   INTEGER, INTENT(IN), OPTIONAL :: STD_iff ! ug RUSTINE POUR LES STD LEVS.....
     1128  include 'clesphys.h'
     1129
     1130    TYPE(ctrl_out), INTENT(IN) :: var
     1131    REAL, DIMENSION(:,:), INTENT(IN) :: field ! --> field(klon,:)
     1132    INTEGER, INTENT(IN), OPTIONAL :: STD_iff ! ug RUSTINE POUR LES STD LEVS.....
    11801133     
    1181   INTEGER :: iff, iff_beg, iff_end
    1182   LOGICAL, SAVE  :: firstx
     1134    INTEGER :: iff, iff_beg, iff_end
     1135    LOGICAL, SAVE  :: firstx
    11831136!$OMP THREADPRIVATE(firstx)
    1184   REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp
    1185   REAL :: Field3d(nbp_lon,jj_nb,SIZE(field,2))
    1186   INTEGER :: ip, n, nlev, nlevx
    1187   INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
    1188   REAL,ALLOCATABLE, DIMENSION(:,:) :: fieldok
    1189 
    1190   IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite3d_phy for ', trim(var%name)
     1137    REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp
     1138    REAL :: Field3d(nbp_lon,jj_nb,SIZE(field,2))
     1139    INTEGER :: ip, n, nlev, nlevx
     1140    INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
     1141    REAL,ALLOCATABLE, DIMENSION(:,:) :: fieldok
    11911142
    11921143  IF (prt_level >= 10) write(lunout,*)'Begin histrwrite3d ',var%name
    … …  
    12021153
    12031154  ! On regarde si on est dans la phase de définition ou d'écriture:
    1204   IF (.NOT.vars_defined) THEN
     1155  IF(.NOT.vars_defined) THEN
    12051156      !Si phase de définition.... on définit
    12061157!$OMP MASTER
    … …  
    12111162      ENDDO
    12121163!$OMP END MASTER
    1213 !--broadcasting the flag that have been changed in histdef3d on OMP masters
    1214       CALL bcast_omp(swaerofree_diag)
    12151164  ELSE
    12161165    !Et sinon on.... écrit
    … …  
    12331182    IF (grid_type==regular_lonlat) CALL grid1Dto2D_mpi(buffer_omp,field3d)
    12341183
     1184
    12351185! BOUCLE SUR LES FICHIERS
    1236     firstx=.true.
    1237 
    1238     IF (ok_all_xml) THEN
     1186     firstx=.true.
     1187
     1188      IF (ok_all_xml) THEN
    12391189#ifdef CPP_XIOS
    12401190          IF (prt_level >= 10) THEN
    … …  
    12501200          ELSE IF (grid_type==unstructured) THEN
    12511201            CALL xios_send_field(var%name, buffer_omp(:,1:nlevx))
    1252         ENDIF
     1202          ENDIF
    12531203
    12541204#else
    12551205        CALL abort_physic ('iophy','cannot have ok_all_xml = .T. without CPP_XIOS defined' ,1)
    12561206#endif
    1257     ELSE 
    1258 
    1259       DO iff=iff_beg, iff_end
    1260           IF (var%flag(iff) <= lev_files(iff) .AND. clef_files(iff)) THEN
     1207      ELSE 
     1208
     1209
     1210     DO iff=iff_beg, iff_end
     1211            IF (var%flag(iff) <= lev_files(iff) .AND. clef_files(iff)) THEN
    12611212#ifdef CPP_XIOS
    12621213              IF (firstx) THEN
    … …  
    12811232              ENDIF
    12821233#endif
    1283               IF (.NOT.clef_stations(iff)) THEN
     1234                IF (.NOT.clef_stations(iff)) THEN
    12841235                        ALLOCATE(index3d(nbp_lon*jj_nb*nlev))
    12851236                        ALLOCATE(fieldok(nbp_lon*jj_nb,nlev))
    … …  
    12951246!#endif
    12961247!                       
    1297               ELSE
     1248                ELSE
    12981249                        nlev=size(field,2)
    12991250                        ALLOCATE(index3d(npstn*nlev))
    … …  
    13191270                        CALL histwrite(nid_files(iff),var%name,itau_iophy,fieldok,npstn*nlev,index3d)
    13201271#endif
    1321               ENDIF
    1322               DEALLOCATE(index3d)
    1323               DEALLOCATE(fieldok)
    1324           ENDIF
     1272                  ENDIF
     1273                  DEALLOCATE(index3d)
     1274                  DEALLOCATE(fieldok)
     1275            ENDIF
    13251276      ENDDO
    1326     ENDIF
     1277      ENDIF
    13271278!$OMP END MASTER   
    13281279  ENDIF ! vars_defined
    1329 
    13301280  IF (prt_level >= 10) write(lunout,*)'End histrwrite3d ',var%name
    1331 
    13321281  END SUBROUTINE histwrite3d_phy
    13331282 
    … …  
    13361285#ifdef CPP_XIOS
    13371286  SUBROUTINE histwrite2d_xios(field_name,field)
    1338 
    13391287  USE dimphy, ONLY: klon, klev
    13401288  USE mod_phys_lmdz_para, ONLY: gather_omp, grid1Dto2D_mpi, &
    13411289                                is_sequential, klon_mpi_begin, klon_mpi_end, &
    1342                                 jj_nb, klon_mpi, is_master
     1290                                jj_nb, klon_mpi
    13431291  USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, unstructured
    13441292  USE xios, ONLY: xios_send_field
    … …  
    13471295  IMPLICIT NONE
    13481296
    1349   CHARACTER(LEN=*), INTENT(IN) :: field_name
    1350   REAL, DIMENSION(:), INTENT(IN) :: field
     1297    CHARACTER(LEN=*), INTENT(IN) :: field_name
     1298    REAL, DIMENSION(:), INTENT(IN) :: field
    13511299     
    1352   REAL,DIMENSION(klon_mpi) :: buffer_omp
    1353   INTEGER, allocatable, DIMENSION(:) :: index2d
    1354   REAL :: Field2d(nbp_lon,jj_nb)
    1355 
    1356   INTEGER :: ip
    1357   REAL, ALLOCATABLE, DIMENSION(:) :: fieldok
    1358 
    1359   IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite2d_xios for ', field_name
    1360 
    1361   IF (prt_level >= 10) WRITE(lunout,*)'Begin histrwrite2d_xios ',field_name
    1362 
    1363   !Et sinon on.... écrit
    1364   IF (SIZE(field)/=klon .AND. SIZE(field)/=klev) CALL abort_physic('iophy::histwrite2d_xios','Field first DIMENSION not equal to klon/klev',1)
    1365    
    1366   IF (SIZE(field) == klev) then
     1300    REAL,DIMENSION(klon_mpi) :: buffer_omp
     1301    INTEGER, allocatable, DIMENSION(:) :: index2d
     1302    REAL :: Field2d(nbp_lon,jj_nb)
     1303
     1304    INTEGER :: ip
     1305    REAL, ALLOCATABLE, DIMENSION(:) :: fieldok
     1306
     1307    IF (prt_level >= 10) WRITE(lunout,*)'Begin histrwrite2d_xios ',field_name
     1308
     1309    !Et sinon on.... écrit
     1310    IF (SIZE(field)/=klon .AND. SIZE(field)/=klev) CALL abort_physic('iophy::histwrite2d_xios','Field first DIMENSION not equal to klon/klev',1)
     1311   
     1312    IF (SIZE(field) == klev) then
    13671313!$OMP MASTER
    13681314        CALL xios_send_field(field_name,field)
    13691315!$OMP END MASTER   
    1370   ELSE
     1316    ELSE
    13711317        CALL Gather_omp(field,buffer_omp)   
    13721318!$OMP MASTER
    … …  
    14111357      ENDIF
    14121358!$OMP END MASTER   
    1413   ENDIF
     1359    ENDIF
    14141360
    14151361  IF (prt_level >= 10) WRITE(lunout,*)'End histrwrite2d_xios ',field_name
    … …  
    14191365! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
    14201366  SUBROUTINE histwrite3d_xios(field_name, field)
    1421 
    14221367  USE dimphy, ONLY: klon, klev
    14231368  USE mod_phys_lmdz_para, ONLY: gather_omp, grid1Dto2D_mpi, &
    14241369                                is_sequential, klon_mpi_begin, klon_mpi_end, &
    1425                                 jj_nb, klon_mpi, is_master
     1370                                jj_nb, klon_mpi
    14261371  USE xios, ONLY: xios_send_field
    14271372  USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, unstructured
    … …  
    14301375  IMPLICIT NONE
    14311376
    1432   CHARACTER(LEN=*), INTENT(IN) :: field_name
    1433   REAL, DIMENSION(:,:), INTENT(IN) :: field ! --> field(klon,:)
    1434 
    1435   REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp
    1436   REAL :: Field3d(nbp_lon,jj_nb,SIZE(field,2))
    1437   INTEGER :: ip, n, nlev
    1438   INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
    1439   REAL,ALLOCATABLE, DIMENSION(:,:) :: fieldok
    1440 
    1441   IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite3d_xios for ', field_name
     1377    CHARACTER(LEN=*), INTENT(IN) :: field_name
     1378    REAL, DIMENSION(:,:), INTENT(IN) :: field ! --> field(klon,:)
     1379
     1380    REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp
     1381    REAL :: Field3d(nbp_lon,jj_nb,SIZE(field,2))
     1382    INTEGER :: ip, n, nlev
     1383    INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
     1384    REAL,ALLOCATABLE, DIMENSION(:,:) :: fieldok
    14421385
    14431386  IF (prt_level >= 10) write(lunout,*)'Begin histrwrite3d_xios ',field_name
    14441387
    1445   !Et on.... écrit
    1446   IF (SIZE(field,1)/=klon .AND. SIZE(field,1)/=klev) CALL abort_physic('iophy::histwrite3d_xios','Field first DIMENSION not equal to klon/klev',1)
    1447    
    1448   IF (SIZE(field,1) == klev) then
     1388    !Et on.... écrit
     1389    IF (SIZE(field,1)/=klon .AND. SIZE(field,1)/=klev) CALL abort_physic('iophy::histwrite3d_xios','Field first DIMENSION not equal to klon/klev',1)
     1390   
     1391    IF (SIZE(field,1) == klev) then
    14491392!$OMP MASTER
    14501393        CALL xios_send_field(field_name,field)
    14511394!$OMP END MASTER   
    1452   ELSE
     1395    ELSE
    14531396        nlev=SIZE(field,2)
    14541397
    … …  
    14981441      ENDIF
    14991442!$OMP END MASTER   
    1500   ENDIF
     1443    ENDIF
    15011444
    15021445  IF (prt_level >= 10) write(lunout,*)'End histrwrite3d_xios ',field_name
    1503 
    15041446  END SUBROUTINE histwrite3d_xios
    15051447
    … …  
    15071449  SUBROUTINE histwrite0d_xios(field_name, field)
    15081450  USE xios, ONLY: xios_send_field
    1509   USE mod_phys_lmdz_para, ONLY: is_master
    1510   USE print_control_mod, ONLY: prt_level,lunout
    15111451  IMPLICIT NONE
    15121452
    1513   CHARACTER(LEN=*), INTENT(IN) :: field_name
    1514   REAL, INTENT(IN) :: field ! --> scalar
    1515 
    1516   IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite0d_xios for ', field_name
     1453    CHARACTER(LEN=*), INTENT(IN) :: field_name
     1454    REAL, INTENT(IN) :: field ! --> scalar
    15171455
    15181456!$OMP MASTER
    1519   CALL xios_send_field(field_name, field)
     1457   CALL xios_send_field(field_name, field)
    15201458!$OMP END MASTER
    15211459
    … …  
    15241462
    15251463#endif
    1526 END MODULE iophy
     1464end module iophy
Note: See TracChangeset for help on using the changeset viewer.