Ignore:
Timestamp:
Feb 10, 2020, 9:54:26 AM (4 years ago)
Author:
acozic
Message:

Add new grid, new axis and new variables for cmip protocole and dr2xml

  • field_group id="coord_hyb"
  • grid_ref="klevp1_bnds"
  • grid_ref="klev_bnds"
  • domain id="greordered"
  • axis id="axis_lat"
  • axis id="bnds"
  • axis id="klevp1"
  • axis id="klev"
File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/branches/IPSLCM5A2.1/libf/phylmd/iophy.F90

    r2529 r3629  
    884884! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
    885885  SUBROUTINE histwrite2d_phy(var,field, STD_iff)
    886   USE dimphy, only: klon
    887   USE mod_phys_lmdz_para, only: gather_omp, grid1dto2d_mpi, &
     886  USE dimphy, ONLY: klon, klev
     887  USE mod_phys_lmdz_para, ONLY: gather_omp, grid1dto2d_mpi, &
    888888                                jj_nb, klon_mpi, klon_mpi_begin, &
    889889                                klon_mpi_end, is_sequential
    … …  
    917917    REAL, ALLOCATABLE, DIMENSION(:) :: fieldok
    918918
    919     IF (prt_level >= 10) THEN
     919!    IF (prt_level >= 10) THEN
    920920      WRITE(lunout,*)'Begin histwrite2d_phy for ',trim(var%name)
    921     ENDIF
     921!    ENDIF
    922922! ug RUSTINE POUR LES STD LEVS.....
    923923      IF (PRESENT(STD_iff)) THEN
    … …  
    948948
    949949    !Et sinon on.... écrit
    950     IF (SIZE(field)/=klon) CALL abort_physic('iophy::histwrite2d_phy','Field first DIMENSION not equal to klon',1)
     950    IF (SIZE(field)/=klon .AND. SIZE(field)/=klev .AND. SIZE(field)/=klev+1) CALL abort_physic('iophy::histwrite2d_phy','Field first DIMENSION not equal to klon/klev',1)   
     951    IF (prt_level >= 10) THEn
     952      WRITE (lunout,*)"histwrite2d_phy: .not.vars_defined ; time to gather and write ", trim(var%name)
     953    ENDIF
    951954   
    952     if (prt_level >= 10) then
    953       write(lunout,*)"histwrite2d_phy: .not.vars_defined ; time to gather and write ", &
    954                      trim(var%name)
    955     endif
    956955   
    957     CALL Gather_omp(field,buffer_omp)
     956    IF (SIZE(field) == klon) then
     957        CALL Gather_omp(field,buffer_omp)
     958    ELSE
     959        buffer_omp(:)=0.
     960    ENDIF
    958961!$OMP MASTER
    959962    CALL grid1Dto2D_mpi(buffer_omp,Field2d)
    … …  
    964967      IF (ok_all_xml) THEN
    965968#ifdef CPP_XIOS
    966           if (prt_level >= 10) then
    967              write(lunout,*)'Dans iophy histwrite2D,var%name ',&
    968                              trim(var%name)                       
    969           endif
    970           CALL xios_send_field(var%name, Field2d)
    971           if (prt_level >= 10) then
    972              write(lunout,*)'Dans iophy histwrite2D,var%name apres xios_send ',&
    973                              trim(var%name)                       
    974           endif
     969          IF (prt_level >= 10) THEN
     970             write(lunout,*)'Dans iophy histwrite2D,var%name ', trim(var%name)                       
     971          ENDIF
     972          IF (SIZE(field) == klon) then
     973              CALL xios_send_field(var%name, Field2d)
     974          ELSE
     975             CALL xios_send_field(var%name, field)
     976          ENDIF
     977          IF (prt_level >= 10) THEN
     978             WRITE (lunout,*)'Dans iophy histwrite2D,var%name apres xios_send ', trim(var%name)                       
     979          ENDIF
    975980#else
    976981        CALL abort_physic ('iophy','cannot have ok_all_xml = .T. without CPP_XIOS defined' ,1)
    … …  
    982987#ifdef CPP_XIOS
    983988               IF (firstx) THEN
    984                   if (prt_level >= 10) then
    985                      write(lunout,*)'Dans iophy histwrite2D,iff,var%name ',&
    986                                     iff,trim(var%name)                       
    987                      write(lunout,*)"histwrite2d_phy:.NOT.clef_stations(iff)and iff==iff_beg, call xios_send_field"
    988                   endif
    989                   CALL xios_send_field(var%name, Field2d)
     989                  IF (prt_level >= 10) THEN
     990                     WRITE (lunout,*)'Dans iophy histwrite2D,iff,var%name ', iff,trim(var%name)                       
     991                     WRITE (lunout,*)"histwrite2d_phy:.NOT.clef_stations(iff)and iff==iff_beg, call xios_send_field"
     992                  ENDIF
     993                  IF (SIZE(field) == klon) then
     994                     CALL xios_send_field(var%name, Field2d)
     995                  ELSE
     996                     CALL xios_send_field(var%name, field)
     997                  ENDIF
    990998                  firstx=.false.
    991999               ENDIF
    … …  
    10831091            iff_beg = 1
    10841092            iff_end = nfiles
    1085       END IF
     1093      ENDIF
    10861094
    10871095  ! On regarde si on est dans la phase de définition ou d'écriture:
    … …  
    10971105  ELSE
    10981106    !Et sinon on.... écrit
    1099     IF (SIZE(field,1)/=klon) CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)
     1107
     1108    IF (SIZE(field,1)/=klon .AND. SIZE(field,1)/=klev .AND. SIZE(field,1)/=klev+1) CALL abort_physic('iophy::histwrite3d_phy','Field first DIMENSION not equal to klon/klev',1)
     1109
    11001110    nlev=SIZE(field,2)
    11011111    if (nlev.eq.klev+1) then
    … …  
    11051115    endif
    11061116
    1107     CALL Gather_omp(field,buffer_omp)
     1117    IF (SIZE(field,1) == klon) then
     1118        CALL Gather_omp(field,buffer_omp)
     1119    ELSE
     1120        buffer_omp(:,:)=0.
     1121    ENDIF
    11081122!$OMP MASTER
    11091123    CALL grid1Dto2D_mpi(buffer_omp,field3d)
    … …  
    11181132             write(lunout,*)'Dans iophy histwrite3D,var%name ',&
    11191133                             trim(var%name)                       
    1120           endif
    1121           CALL xios_send_field(var%name, Field3d(:,:,1:nlevx))
     1134          ENDIF
     1135          IF (SIZE(field,1) == klon) then
     1136             CALL xios_send_field(var%name, Field3d(:,:,1:nlevx))
     1137          ELSE
     1138             CALL xios_send_field(var%name, field)
     1139          ENDIF
    11221140#else
    11231141        CALL abort_physic ('iophy','cannot have ok_all_xml = .T. without CPP_XIOS defined' ,1)
    … …  
    11361154                                  trim(var%name), ' with iim jjm nlevx = ', &
    11371155                                  nbp_lon,jj_nb,nlevx
    1138                 endif
    1139                 CALL xios_send_field(var%name, Field3d(:,:,1:nlevx))
    1140                             firstx=.false.
     1156                ENDIF
     1157                IF (SIZE(field,1) == klon) then
     1158                    CALL xios_send_field(var%name, Field3d(:,:,1:nlevx))
     1159                ELSE
     1160                     CALL xios_send_field(var%name, field)
     1161                ENDIF
     1162                firstx=.false.
    11411163              ENDIF
    11421164#endif
    … …  
    11941216#ifdef CPP_XIOS
    11951217  SUBROUTINE histwrite2d_xios(field_name,field)
    1196   USE dimphy, only: klon
    1197   USE mod_phys_lmdz_para, only: gather_omp, grid1Dto2D_mpi, &
     1218  USE dimphy, ONLY: klon, klev
     1219  USE mod_phys_lmdz_para, ONLY: gather_omp, grid1Dto2D_mpi, &
    11981220                                is_sequential, klon_mpi_begin, klon_mpi_end, &
    11991221                                jj_nb, klon_mpi
    … …  
    12171239
    12181240    !Et sinon on.... écrit
    1219     IF (SIZE(field)/=klon) CALL abort_physic('iophy::histwrite2d_xios','Field first DIMENSION not equal to klon',1)
     1241    IF (SIZE(field)/=klon .AND. SIZE(field)/=klev .AND. SIZE(field)/=klev+1) CALL abort_physic('iophy::histwrite2d_xios','Field first DIMENSION not equal to klon/klev',1)
    12201242   
    1221     CALL Gather_omp(field,buffer_omp)   
     1243    IF (SIZE(field) == klev .OR. SIZE(field) == klev+1) then
     1244!$OMP MASTER
     1245        CALL xios_send_field(field_name,field)
     1246!$OMP END MASTER   
     1247    ELSE
     1248        CALL Gather_omp(field,buffer_omp)   
    12221249!$OMP MASTER
    12231250    CALL grid1Dto2D_mpi(buffer_omp,Field2d)
    … …  
    12571284    deallocate(fieldok)
    12581285!$OMP END MASTER   
     1286    ENDIF
    12591287
    12601288  IF (prt_level >= 10) WRITE(lunout,*)'End histrwrite2d_xios ',field_name
    … …  
    12861314
    12871315    !Et on.... écrit
    1288     IF (SIZE(field,1)/=klon) CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)
    1289     nlev=SIZE(field,2)
     1316    IF (SIZE(field,1)/=klon .AND. SIZE(field,1)/=klev .AND. SIZE(field,1)/=klev+1) then
     1317      write(lunout,*)' histrwrite3d_xios ', field_name, SIZE(field)
     1318      CALL abort_physic('iophy::histwrite3d_xios','Field first DIMENSION not equal to klon/klev',1)
     1319    ENDIF
     1320   
     1321    IF (SIZE(field,1) == klev .OR. SIZE(field,1) == klev+1) then
     1322!$OMP MASTER
     1323        CALL xios_send_field(field_name,field)
     1324!$OMP END MASTER   
     1325    ELSE
     1326        nlev=SIZE(field,2)
    12901327
    12911328
    … …  
    13281365    deallocate(fieldok)
    13291366!$OMP END MASTER   
     1367    ENDIF
    13301368
    13311369  IF (prt_level >= 10) write(lunout,*)'End histrwrite3d_xios ',field_name
    13321370  END SUBROUTINE histwrite3d_xios
     1371
     1372#ifdef CPP_XIOS
     1373  SUBROUTINE histwrite0d_xios(field_name, field)
     1374  USE xios, ONLY: xios_send_field
     1375  IMPLICIT NONE
     1376
     1377    CHARACTER(LEN=*), INTENT(IN) :: field_name
     1378    REAL, INTENT(IN) :: field ! --> scalar
     1379
     1380!$OMP MASTER
     1381   CALL xios_send_field(field_name, field)
     1382!$OMP END MASTER
     1383
     1384  END SUBROUTINE histwrite0d_xios
     1385#endif
     1386
    13331387#endif
    13341388end module iophy
Note: See TracChangeset for help on using the changeset viewer.