Ignore:
Timestamp:
Mar 14, 2018, 7:02:21 PM (6 years ago)
Author:
oboucher
Message:

Added a broadcast of flags that are changed back to T in histdef2d and histdef3d
Improved the indenting throughout

File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r3238 r3266  
    4040! ug Routine pour définir itau_iophy depuis phys_output_write_mod:
    4141  SUBROUTINE set_itau_iophy(ito)
    42       IMPLICIT NONE
    43       INTEGER, INTENT(IN) :: ito
    44       itau_iophy = ito
     42    IMPLICIT NONE
     43    INTEGER, INTENT(IN) :: ito
     44    itau_iophy = ito
    4545  END SUBROUTINE
    4646
    4747  SUBROUTINE init_iophy_new(rlat,rlon)
    48   USE dimphy, ONLY: klon
    49   USE mod_phys_lmdz_para, ONLY: gather, bcast, &
    50                                 jj_nb, jj_begin, jj_end, ii_begin, ii_end, &
    51                                 mpi_size, mpi_rank, klon_mpi, &
     48
     49    USE dimphy, ONLY: klon
     50    USE mod_phys_lmdz_para, ONLY: gather, bcast, &
     51                                  jj_nb, jj_begin, jj_end, ii_begin, ii_end, &
     52                                  mpi_size, mpi_rank, klon_mpi, &
    5253                                is_sequential, is_south_pole_dyn
    53   USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo
    54   USE print_control_mod, ONLY: prt_level,lunout
     54    USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo
     55    USE print_control_mod, ONLY: prt_level,lunout
    5556#ifdef CPP_IOIPSL
    56   USE ioipsl, ONLY: flio_dom_set
    57 #endif
    58 #ifdef CPP_XIOS
    59   USE wxios, ONLY: wxios_domain_param
    60 #endif
    61   IMPLICIT NONE
     57    USE ioipsl, ONLY: flio_dom_set
     58#endif
     59#ifdef CPP_XIOS
     60    USE wxios, ONLY: wxios_domain_param
     61#endif
     62    IMPLICIT NONE
    6263    REAL,DIMENSION(klon),INTENT(IN) :: rlon
    6364    REAL,DIMENSION(klon),INTENT(IN) :: rlat
    … …  
    163164  END SUBROUTINE init_iophy_new
    164165
     166
    165167  SUBROUTINE init_iophy(lat,lon)
    166   USE mod_phys_lmdz_para, ONLY: jj_begin, jj_end, ii_begin, ii_end, jj_nb, &
    167                                 mpi_size, mpi_rank
    168   USE ioipsl, ONLY: flio_dom_set
    169   USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
    170   IMPLICIT NONE
     168
     169    USE mod_phys_lmdz_para, ONLY: jj_begin, jj_end, ii_begin, ii_end, jj_nb, &
     170                                  mpi_size, mpi_rank
     171    USE ioipsl, ONLY: flio_dom_set
     172    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
     173
     174    IMPLICIT NONE
     175
    171176    REAL,DIMENSION(nbp_lon),INTENT(IN) :: lon
    172177    REAL,DIMENSION(nbp_lat),INTENT(IN) :: lat
    … …  
    216221#endif
    217222  IMPLICIT NONE
    218   include 'clesphys.h'
    219    
    220     CHARACTER*(*), INTENT(IN) :: name
    221     INTEGER, INTENT(IN) :: itau0
    222     REAL,INTENT(IN) :: zjulian
    223     REAL,INTENT(IN) :: dtime
    224     CHARACTER(LEN=*), INTENT(IN) :: ffreq
    225     INTEGER,INTENT(IN) :: lev
    226     INTEGER,INTENT(OUT) :: nhori
    227     INTEGER,INTENT(OUT) :: nid_day
     223  INCLUDE 'clesphys.h'
     224   
     225  CHARACTER*(*), INTENT(IN) :: name
     226  INTEGER, INTENT(IN) :: itau0
     227  REAL,INTENT(IN) :: zjulian
     228  REAL,INTENT(IN) :: dtime
     229  CHARACTER(LEN=*), INTENT(IN) :: ffreq
     230  INTEGER,INTENT(IN) :: lev
     231  INTEGER,INTENT(OUT) :: nhori
     232  INTEGER,INTENT(OUT) :: nid_day
    228233
    229234!$OMP MASTER   
    230     IF (is_sequential) THEN
    231       call histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
    232                    1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day)
    233     ELSE
    234       call histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
    235                    1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day,phys_domain_id)
    236     ENDIF
    237 
    238 #ifdef CPP_XIOS
    239     ! ug OMP en chantier...
    240     IF((.NOT. is_using_mpi) .OR. is_mpi_root) THEN
    241         ! ug Création du fichier
    242       IF (.not. ok_all_xml) THEN
    243         CALL wxios_add_file(name, ffreq, lev)
    244       ENDIF
    245     ENDIF
     235  IF (is_sequential) THEN
     236    CALL histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
     237                 1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day)
     238  ELSE
     239    CALL histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
     240                 1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day,phys_domain_id)
     241  ENDIF
     242
     243#ifdef CPP_XIOS
     244  ! ug OMP en chantier...
     245  IF((.NOT. is_using_mpi) .OR. is_mpi_root) THEN
     246      ! ug Création du fichier
     247    IF (.not. ok_all_xml) THEN
     248      CALL wxios_add_file(name, ffreq, lev)
     249    ENDIF
     250  ENDIF
    246251#endif
    247252!$OMP END MASTER
    … …  
    267272#ifndef CPP_IOIPSL_NO_OUTPUT
    268273    IF (is_sequential) THEN
    269       call histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
     274      CALL histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
    270275                   1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day)
    271276    ELSE
    272       call histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
     277      CALL histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
    273278                   1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day,phys_domain_id)
    274279    ENDIF
    … …  
    404409
    405410#ifndef CPP_IOIPSL_NO_OUTPUT
    406      call histbeg(nname,pim,plon,plon_bounds, &
     411     CALL histbeg(nname,pim,plon,plon_bounds, &
    407412                           plat,plat_bounds, &
    408413                           itau0, zjulian, dtime, nnhori, nnid_day)
    … …  
    445450     ENDDO
    446451#ifndef CPP_IOIPSL_NO_OUTPUT
    447      call histbeg(nname,npstn,npplon,npplon_bounds, &
     452     CALL histbeg(nname,npstn,npplon,npplon_bounds, &
    448453                            npplat,npplat_bounds, &
    449454                            itau0,zjulian,dtime,nnhori,nnid_day,phys_domain_id)
    … …  
    706711    USE phys_output_var_mod, ONLY: ctrl_out, type_ecri_files, zoutm, zdtime_moy, &
    707712                                   clef_stations, phys_out_filenames, lev_files, &
    708                                    nid_files, nhorim, swaerofree_diag, swaero_diag, dryaod_diag, levmin, &
     713                                   nid_files, nhorim, swaerofree_diag, levmin, &
    709714                                   levmax, nvertm
    710715    USE print_control_mod, ONLY: prt_level,lunout
    … …  
    740745    ENDIF
    741746
    742 
    743747    ! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def
    744748    CALL conf_physoutputs(var%name,var%flag)
    … …  
    809813 
    810814  SUBROUTINE histwrite2d_phy_old(nid,lpoint,name,itau,field)
    811   USE dimphy, ONLY: klon
    812   USE mod_phys_lmdz_para, ONLY: Gather_omp, grid1Dto2D_mpi, &
    813                                 is_sequential, klon_mpi_begin, klon_mpi_end, &
    814                                 jj_nb, klon_mpi, is_master
    815   USE ioipsl, ONLY: histwrite
    816   USE print_control_mod, ONLY: prt_level,lunout
    817   USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
    818   IMPLICIT NONE
     815
     816    USE dimphy, ONLY: klon
     817    USE mod_phys_lmdz_para, ONLY: Gather_omp, grid1Dto2D_mpi, &
     818                                  is_sequential, klon_mpi_begin, klon_mpi_end, &
     819                                  jj_nb, klon_mpi, is_master
     820    USE ioipsl, ONLY: histwrite
     821    USE print_control_mod, ONLY: prt_level,lunout
     822    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
     823
     824    IMPLICIT NONE
    819825   
    820826    INTEGER,INTENT(IN) :: nid
    … …  
    836842!$OMP MASTER
    837843    CALL grid1Dto2D_mpi(buffer_omp,Field2d)
    838     if(.NOT.lpoint) THEN
     844    IF (.NOT.lpoint) THEN
    839845     ALLOCATE(index2d(nbp_lon*jj_nb))
    840846     ALLOCATE(fieldok(nbp_lon*jj_nb))
    … …  
    874880
    875881  SUBROUTINE histwrite3d_phy_old(nid,lpoint,name,itau,field)
    876   USE dimphy, ONLY: klon
    877   USE mod_phys_lmdz_para, ONLY: Gather_omp, grid1Dto2D_mpi, &
    878                                 is_sequential, klon_mpi_begin, klon_mpi_end, &
    879                                 jj_nb, klon_mpi, is_master
    880   USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
    881   USE ioipsl, ONLY: histwrite
    882   USE print_control_mod, ONLY: prt_level,lunout
    883   IMPLICIT NONE
     882
     883    USE dimphy, ONLY: klon
     884    USE mod_phys_lmdz_para, ONLY: Gather_omp, grid1Dto2D_mpi, &
     885                                  is_sequential, klon_mpi_begin, klon_mpi_end, &
     886                                  jj_nb, klon_mpi, is_master
     887    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
     888    USE ioipsl, ONLY: histwrite
     889    USE print_control_mod, ONLY: prt_level,lunout
     890
     891    IMPLICIT NONE
    884892   
    885893    INTEGER,INTENT(IN) :: nid
    … …  
    903911    CALL grid1Dto2D_mpi(buffer_omp,field3d)
    904912    IF (.NOT.lpoint) THEN
    905      ALLOCATE(index3d(nbp_lon*jj_nb*nlev))
    906      ALLOCATE(fieldok(nbp_lon*jj_nb,nlev))
    907      IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL'
    908      CALL histwrite(nid,name,itau,Field3d,nbp_lon*jj_nb*nlev,index3d)
    909      IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
    910    ELSE
     913      ALLOCATE(index3d(nbp_lon*jj_nb*nlev))
     914      ALLOCATE(fieldok(nbp_lon*jj_nb,nlev))
     915      IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL'
     916      CALL histwrite(nid,name,itau,Field3d,nbp_lon*jj_nb*nlev,index3d)
     917      IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
     918    ELSE
    911919      nlev=size(field,2)
    912920      ALLOCATE(index3d(npstn*nlev))
    … …  
    914922
    915923      IF (is_sequential) THEN
    916 !      klon_mpi_begin=1
    917 !      klon_mpi_end=klon
    918        DO n=1, nlev
    919        DO ip=1, npstn
    920         fieldok(ip,n)=buffer_omp(nptabij(ip),n)
    921        ENDDO
    922        ENDDO
     924!       klon_mpi_begin=1
     925!       klon_mpi_end=klon
     926        DO n=1, nlev
     927        DO ip=1, npstn
     928          fieldok(ip,n)=buffer_omp(nptabij(ip),n)
     929        ENDDO
     930        ENDDO
    923931      ELSE
    924        DO n=1, nlev
    925        DO ip=1, npstn
    926         IF(nptabij(ip).GE.klon_mpi_begin.AND. &
    927          nptabij(ip).LE.klon_mpi_end) THEN
    928          fieldok(ip,n)=buffer_omp(nptabij(ip)-klon_mpi_begin+1,n)
    929         ENDIF
    930        ENDDO
    931        ENDDO
     932        DO n=1, nlev
     933        DO ip=1, npstn
     934          IF(nptabij(ip).GE.klon_mpi_begin.AND. &
     935           nptabij(ip).LE.klon_mpi_end) THEN
     936           fieldok(ip,n)=buffer_omp(nptabij(ip)-klon_mpi_begin+1,n)
     937          ENDIF
     938        ENDDO
     939        ENDDO
    932940      ENDIF
    933941      IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL'
    … …  
    935943      IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
    936944    ENDIF
    937   DEALLOCATE(index3d)
    938   DEALLOCATE(fieldok)
     945    DEALLOCATE(index3d)
     946    DEALLOCATE(fieldok)
    939947!$OMP END MASTER   
    940948
    941949  END SUBROUTINE histwrite3d_phy_old
    942 
    943 
    944950
    945951
    946952! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
    947953  SUBROUTINE histwrite2d_phy(var,field, STD_iff)
     954
     955  USE mod_phys_lmdz_omp_transfert, ONLY: bcast_omp
    948956  USE dimphy, ONLY: klon, klev
    949957  USE mod_phys_lmdz_para, ONLY: gather_omp, grid1dto2d_mpi, &
    … …  
    953961  USE phys_output_var_mod, ONLY: ctrl_out, clef_files, lev_files, &
    954962                                 nfiles, vars_defined, clef_stations, &
    955                                  nid_files
     963                                 nid_files, swaerofree_diag, swaero_diag, dryaod_diag, ok_4xCO2atm
    956964  USE print_control_mod, ONLY: prt_level,lunout
    957965  USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
    … …  
    960968#endif
    961969
    962 
    963970  IMPLICIT NONE
    964   include 'clesphys.h'
    965 
    966     TYPE(ctrl_out), INTENT(IN) :: var
    967     REAL, DIMENSION(:), INTENT(IN) :: field
    968     INTEGER, INTENT(IN), OPTIONAL :: STD_iff ! ug RUSTINE POUR LES STD LEVS.....
     971  INCLUDE 'clesphys.h'
     972
     973  TYPE(ctrl_out), INTENT(IN) :: var
     974  REAL, DIMENSION(:), INTENT(IN) :: field
     975  INTEGER, INTENT(IN), OPTIONAL :: STD_iff ! ug RUSTINE POUR LES STD LEVS.....
    969976     
    970     INTEGER :: iff, iff_beg, iff_end
    971     LOGICAL, SAVE  :: firstx
     977  INTEGER :: iff, iff_beg, iff_end
     978  LOGICAL, SAVE  :: firstx
    972979!$OMP THREADPRIVATE(firstx)
    973980
    974     REAL,DIMENSION(klon_mpi) :: buffer_omp
    975     INTEGER, allocatable, DIMENSION(:) :: index2d
    976     REAL :: Field2d(nbp_lon,jj_nb)
    977 
    978     INTEGER :: ip
    979     REAL, ALLOCATABLE, DIMENSION(:) :: fieldok
    980 
    981     IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite2d_phy for ',trim(var%name)
    982 
    983     IF (prt_level >= 10) THEN
    984       WRITE(lunout,*)'Begin histwrite2d_phy for ',trim(var%name)
    985     ENDIF
     981  REAL,DIMENSION(klon_mpi) :: buffer_omp
     982  INTEGER, allocatable, DIMENSION(:) :: index2d
     983  REAL :: Field2d(nbp_lon,jj_nb)
     984
     985  INTEGER :: ip
     986  REAL, ALLOCATABLE, DIMENSION(:) :: fieldok
     987
     988  IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite2d_phy for ',trim(var%name)
     989
     990  IF (prt_level >= 10) THEN
     991    WRITE(lunout,*)'Begin histwrite2d_phy for ',trim(var%name)
     992  ENDIF
     993
    986994! ug RUSTINE POUR LES STD LEVS.....
    987       IF (PRESENT(STD_iff)) THEN
    988             iff_beg = STD_iff
    989             iff_end = STD_iff
    990       ELSE
    991             iff_beg = 1
    992             iff_end = nfiles
    993       ENDIF
     995  IF (PRESENT(STD_iff)) THEN
     996        iff_beg = STD_iff
     997        iff_end = STD_iff
     998  ELSE
     999        iff_beg = 1
     1000        iff_end = nfiles
     1001  ENDIF
    9941002
    9951003  ! On regarde si on est dans la phase de définition ou d'écriture:
    … …  
    10081016      ENDIF
    10091017!$OMP END MASTER
     1018!--broadcasting the flags that have been changed in histdef2d on OMP masters
     1019      CALL bcast_omp(swaero_diag)
     1020      CALL bcast_omp(swaerofree_diag)
     1021      CALL bcast_omp(dryaod_diag)
     1022      CALL bcast_omp(ok_4xCO2atm)
     1023
    10101024  ELSE
    10111025
    … …  
    11091123!$OMP END MASTER   
    11101124  ENDIF ! vars_defined
     1125
    11111126  IF (prt_level >= 10) WRITE(lunout,*)'End histwrite2d_phy ',trim(var%name)
     1127
    11121128  END SUBROUTINE histwrite2d_phy
    11131129
    … …  
    11151131! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
    11161132  SUBROUTINE histwrite3d_phy(var, field, STD_iff)
     1133
     1134  USE mod_phys_lmdz_omp_transfert, ONLY: bcast_omp
    11171135  USE dimphy, ONLY: klon, klev
    11181136  USE mod_phys_lmdz_para, ONLY: gather_omp, grid1dto2d_mpi, &
    … …  
    11221140  USE phys_output_var_mod, ONLY: ctrl_out, clef_files, lev_files, &
    11231141                                 nfiles, vars_defined, clef_stations, &
    1124                                  nid_files
     1142                                 nid_files, swaerofree_diag
    11251143  USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
    11261144#ifdef CPP_XIOS
    … …  
    11301148
    11311149  IMPLICIT NONE
    1132   include 'clesphys.h'
    1133 
    1134     TYPE(ctrl_out), INTENT(IN) :: var
    1135     REAL, DIMENSION(:,:), INTENT(IN) :: field ! --> field(klon,:)
    1136     INTEGER, INTENT(IN), OPTIONAL :: STD_iff ! ug RUSTINE POUR LES STD LEVS.....
     1150  INCLUDE 'clesphys.h'
     1151
     1152  TYPE(ctrl_out), INTENT(IN) :: var
     1153  REAL, DIMENSION(:,:), INTENT(IN) :: field ! --> field(klon,:)
     1154  INTEGER, INTENT(IN), OPTIONAL :: STD_iff ! ug RUSTINE POUR LES STD LEVS.....
    11371155     
    1138     INTEGER :: iff, iff_beg, iff_end
    1139     LOGICAL, SAVE  :: firstx
     1156  INTEGER :: iff, iff_beg, iff_end
     1157  LOGICAL, SAVE  :: firstx
    11401158!$OMP THREADPRIVATE(firstx)
    1141     REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp
    1142     REAL :: Field3d(nbp_lon,jj_nb,SIZE(field,2))
    1143     INTEGER :: ip, n, nlev, nlevx
    1144     INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
    1145     REAL,ALLOCATABLE, DIMENSION(:,:) :: fieldok
     1159  REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp
     1160  REAL :: Field3d(nbp_lon,jj_nb,SIZE(field,2))
     1161  INTEGER :: ip, n, nlev, nlevx
     1162  INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
     1163  REAL,ALLOCATABLE, DIMENSION(:,:) :: fieldok
    11461164
    11471165  IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite3d_phy for ', trim(var%name)
    … …  
    11591177
    11601178  ! On regarde si on est dans la phase de définition ou d'écriture:
    1161   IF(.NOT.vars_defined) THEN
     1179  IF (.NOT.vars_defined) THEN
    11621180      !Si phase de définition.... on définit
    11631181!$OMP MASTER
    … …  
    11681186      ENDDO
    11691187!$OMP END MASTER
     1188!--broadcasting the flag that have been changed in histdef3d on OMP masters
     1189      CALL bcast_omp(swaerofree_diag)
    11701190  ELSE
    11711191    !Et sinon on.... écrit
    … …  
    11881208    CALL grid1Dto2D_mpi(buffer_omp,field3d)
    11891209
    1190 
    11911210! BOUCLE SUR LES FICHIERS
    1192      firstx=.true.
    1193 
    1194       IF (ok_all_xml) THEN
    1195 #ifdef CPP_XIOS
    1196           IF (prt_level >= 10) THEN
    1197              write(lunout,*)'Dans iophy histwrite3D,var%name ',&
    1198                              trim(var%name)                       
    1199           ENDIF
    1200           IF (SIZE(field,1) == klon) then
     1211    firstx=.true.
     1212
     1213    IF (ok_all_xml) THEN
     1214#ifdef CPP_XIOS
     1215        IF (prt_level >= 10) THEN
     1216             write(lunout,*)'Dans iophy histwrite3D,var%name ',trim(var%name)                       
     1217        ENDIF
     1218        IF (SIZE(field,1) == klon) then
    12011219             CALL xios_send_field(var%name, Field3d(:,:,1:nlevx))
    1202           ELSE
     1220        ELSE
    12031221             CALL xios_send_field(var%name, field)
    1204           ENDIF
     1222        ENDIF
    12051223#else
    12061224        CALL abort_physic ('iophy','cannot have ok_all_xml = .T. without CPP_XIOS defined' ,1)
    12071225#endif
    1208       ELSE 
    1209 
    1210 
    1211      DO iff=iff_beg, iff_end
    1212             IF (var%flag(iff) <= lev_files(iff) .AND. clef_files(iff)) THEN
     1226    ELSE 
     1227
     1228      DO iff=iff_beg, iff_end
     1229          IF (var%flag(iff) <= lev_files(iff) .AND. clef_files(iff)) THEN
    12131230#ifdef CPP_XIOS
    12141231              IF (firstx) THEN
    … …  
    12281245              ENDIF
    12291246#endif
    1230                 IF (.NOT.clef_stations(iff)) THEN
     1247              IF (.NOT.clef_stations(iff)) THEN
    12311248                        ALLOCATE(index3d(nbp_lon*jj_nb*nlev))
    12321249                        ALLOCATE(fieldok(nbp_lon*jj_nb,nlev))
    … …  
    12421259!#endif
    12431260!                       
    1244                 ELSE
     1261              ELSE
    12451262                        nlev=size(field,2)
    12461263                        ALLOCATE(index3d(npstn*nlev))
    … …  
    12661283                        CALL histwrite(nid_files(iff),var%name,itau_iophy,fieldok,npstn*nlev,index3d)
    12671284#endif
    1268                   ENDIF
    1269                   DEALLOCATE(index3d)
    1270                   DEALLOCATE(fieldok)
    1271             ENDIF
     1285              ENDIF
     1286              DEALLOCATE(index3d)
     1287              DEALLOCATE(fieldok)
     1288          ENDIF
    12721289      ENDDO
    1273       ENDIF
     1290    ENDIF
    12741291!$OMP END MASTER   
    12751292  ENDIF ! vars_defined
     1293
    12761294  IF (prt_level >= 10) write(lunout,*)'End histrwrite3d ',var%name
     1295
    12771296  END SUBROUTINE histwrite3d_phy
    12781297 
    … …  
    12811300#ifdef CPP_XIOS
    12821301  SUBROUTINE histwrite2d_xios(field_name,field)
     1302
    12831303  USE dimphy, ONLY: klon, klev
    12841304  USE mod_phys_lmdz_para, ONLY: gather_omp, grid1Dto2D_mpi, &
    … …  
    12911311  IMPLICIT NONE
    12921312
    1293     CHARACTER(LEN=*), INTENT(IN) :: field_name
    1294     REAL, DIMENSION(:), INTENT(IN) :: field
     1313  CHARACTER(LEN=*), INTENT(IN) :: field_name
     1314  REAL, DIMENSION(:), INTENT(IN) :: field
    12951315     
    1296     REAL,DIMENSION(klon_mpi) :: buffer_omp
    1297     INTEGER, allocatable, DIMENSION(:) :: index2d
    1298     REAL :: Field2d(nbp_lon,jj_nb)
    1299 
    1300     INTEGER :: ip
    1301     REAL, ALLOCATABLE, DIMENSION(:) :: fieldok
    1302 
    1303     IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite2d_xios for ', field_name
    1304 
    1305     IF (prt_level >= 10) WRITE(lunout,*)'Begin histrwrite2d_xios ',field_name
    1306 
    1307     !Et sinon on.... écrit
    1308     IF (SIZE(field)/=klon .AND. SIZE(field)/=klev) CALL abort_physic('iophy::histwrite2d_xios','Field first DIMENSION not equal to klon/klev',1)
    1309    
    1310     IF (SIZE(field) == klev) then
     1316  REAL,DIMENSION(klon_mpi) :: buffer_omp
     1317  INTEGER, allocatable, DIMENSION(:) :: index2d
     1318  REAL :: Field2d(nbp_lon,jj_nb)
     1319
     1320  INTEGER :: ip
     1321  REAL, ALLOCATABLE, DIMENSION(:) :: fieldok
     1322
     1323  IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite2d_xios for ', field_name
     1324
     1325  IF (prt_level >= 10) WRITE(lunout,*)'Begin histrwrite2d_xios ',field_name
     1326
     1327  !Et sinon on.... écrit
     1328  IF (SIZE(field)/=klon .AND. SIZE(field)/=klev) CALL abort_physic('iophy::histwrite2d_xios','Field first DIMENSION not equal to klon/klev',1)
     1329   
     1330  IF (SIZE(field) == klev) then
    13111331!$OMP MASTER
    13121332        CALL xios_send_field(field_name,field)
    13131333!$OMP END MASTER   
    1314     ELSE
     1334  ELSE
    13151335        CALL Gather_omp(field,buffer_omp)   
    13161336!$OMP MASTER
    … …  
    13511371        DEALLOCATE(fieldok)
    13521372!$OMP END MASTER   
    1353     ENDIF
     1373  ENDIF
    13541374
    13551375  IF (prt_level >= 10) WRITE(lunout,*)'End histrwrite2d_xios ',field_name
    … …  
    13591379! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
    13601380  SUBROUTINE histwrite3d_xios(field_name, field)
     1381
    13611382  USE dimphy, ONLY: klon, klev
    13621383  USE mod_phys_lmdz_para, ONLY: gather_omp, grid1Dto2D_mpi, &
    … …  
    13691390  IMPLICIT NONE
    13701391
    1371     CHARACTER(LEN=*), INTENT(IN) :: field_name
    1372     REAL, DIMENSION(:,:), INTENT(IN) :: field ! --> field(klon,:)
    1373 
    1374     REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp
    1375     REAL :: Field3d(nbp_lon,jj_nb,SIZE(field,2))
    1376     INTEGER :: ip, n, nlev
    1377     INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
    1378     REAL,ALLOCATABLE, DIMENSION(:,:) :: fieldok
    1379 
    1380     IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite3d_xios for ', field_name
    1381 
    1382     IF (prt_level >= 10) write(lunout,*)'Begin histrwrite3d_xios ',field_name
    1383 
    1384     !Et on.... écrit
    1385     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)
    1386    
    1387     IF (SIZE(field,1) == klev) then
     1392  CHARACTER(LEN=*), INTENT(IN) :: field_name
     1393  REAL, DIMENSION(:,:), INTENT(IN) :: field ! --> field(klon,:)
     1394
     1395  REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp
     1396  REAL :: Field3d(nbp_lon,jj_nb,SIZE(field,2))
     1397  INTEGER :: ip, n, nlev
     1398  INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
     1399  REAL,ALLOCATABLE, DIMENSION(:,:) :: fieldok
     1400
     1401  IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite3d_xios for ', field_name
     1402
     1403  IF (prt_level >= 10) write(lunout,*)'Begin histrwrite3d_xios ',field_name
     1404
     1405  !Et on.... écrit
     1406  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)
     1407   
     1408  IF (SIZE(field,1) == klev) then
    13881409!$OMP MASTER
    13891410        CALL xios_send_field(field_name,field)
    13901411!$OMP END MASTER   
    1391     ELSE
     1412  ELSE
    13921413        nlev=SIZE(field,2)
    13931414
    … …  
    14311452        DEALLOCATE(fieldok)
    14321453!$OMP END MASTER   
    1433     ENDIF
     1454  ENDIF
    14341455
    14351456  IF (prt_level >= 10) write(lunout,*)'End histrwrite3d_xios ',field_name
     1457
    14361458  END SUBROUTINE histwrite3d_xios
    14371459
    … …  
    14431465  IMPLICIT NONE
    14441466
    1445     CHARACTER(LEN=*), INTENT(IN) :: field_name
    1446     REAL, INTENT(IN) :: field ! --> scalar
    1447 
    1448     IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite0d_xios for ', field_name
     1467  CHARACTER(LEN=*), INTENT(IN) :: field_name
     1468  REAL, INTENT(IN) :: field ! --> scalar
     1469
     1470  IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite0d_xios for ', field_name
    14491471
    14501472!$OMP MASTER
    1451    CALL xios_send_field(field_name, field)
     1473  CALL xios_send_field(field_name, field)
    14521474!$OMP END MASTER
    14531475
    … …  
    14561478
    14571479#endif
    1458 end module iophy
     1480END MODULE iophy
Note: See TracChangeset for help on using the changeset viewer.