Ignore:
Timestamp:
Nov 21, 2019, 4:43:45 PM (4 years ago)
Author:
lguez
Message:

Merge revisions 3427:3600 of trunk into branch Ocean_skin

Location:
LMDZ6/branches/Ocean_skin
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Ocean_skin

  • LMDZ6/branches/Ocean_skin/libf/phylmd/iophy.F90

    r3266 r3605  
    1818#ifdef CPP_XIOS
    1919  INTERFACE histwrite_phy
    20 !#ifdef CPP_XIOSnew
    2120    MODULE PROCEDURE histwrite2d_phy,histwrite3d_phy,histwrite2d_phy_old,histwrite3d_phy_old,histwrite2d_xios,histwrite3d_xios,histwrite0d_xios
    22 !#else
    23 !    MODULE PROCEDURE histwrite2d_phy,histwrite3d_phy,histwrite2d_phy_old,histwrite3d_phy_old,histwrite2d_xios,histwrite3d_xios
    24 !#endif
    25 
    2621  END INTERFACE
    2722#else
    … …  
    5247                                  mpi_size, mpi_rank, klon_mpi, &
    5348                                is_sequential, is_south_pole_dyn
    54     USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo
    55     USE print_control_mod, ONLY: prt_level,lunout
     49  USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, grid_type, unstructured
     50  USE print_control_mod, ONLY: prt_level,lunout
    5651#ifdef CPP_IOIPSL
    5752    USE ioipsl, ONLY: flio_dom_set
    5853#endif
    5954#ifdef CPP_XIOS
    60     USE wxios, ONLY: wxios_domain_param
     55  use wxios, ONLY: wxios_domain_param, wxios_domain_param_unstructured, wxios_context_init
    6156#endif
    6257    IMPLICIT NONE
    … …  
    7772    INTEGER :: data_ibegin, data_iend
    7873
    79     CALL gather(rlat,rlat_glo)
    80     CALL bcast(rlat_glo)
    81     CALL gather(rlon,rlon_glo)
    82     CALL bcast(rlon_glo)
     74#ifdef CPP_XIOS
     75      CALL wxios_context_init
     76#endif
     77   
     78
     79    IF (grid_type==unstructured) THEN
     80   
     81#ifdef CPP_XIOS
     82      CALL wxios_domain_param_unstructured("dom_glo")
     83#endif
     84
     85    ELSE
     86
     87      CALL gather(rlat,rlat_glo)
     88      CALL bcast(rlat_glo)
     89      CALL gather(rlon,rlon_glo)
     90      CALL bcast(rlon_glo)
    8391   
    8492!$OMP MASTER 
    … …  
    133141#endif
    134142#ifdef CPP_XIOS
    135     ! Set values for the mask:
    136     IF (mpi_rank == 0) THEN
    137         data_ibegin = 0
    138     ELSE
    139         data_ibegin = ii_begin - 1
    140     ENDIF
    141 
    142     IF (mpi_rank == mpi_size-1) THEN
    143         data_iend = nbp_lon
    144     ELSE
    145         data_iend = ii_end + 1
    146     ENDIF
    147 
    148     IF (prt_level>=10) THEN
    149       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
    150       write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," nbp_lon=",nbp_lon," nbp_lat=",nbp_lat
    151       write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
    152       write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
    153       write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," is_south_pole=",is_south_pole_dyn
    154     ENDIF
    155 
    156     ! Initialize the XIOS domain coreesponding to this process:
    157     CALL wxios_domain_param("dom_glo", is_sequential, nbp_lon, jj_nb, nbp_lon, nbp_lat, &
    158                             1, nbp_lon, ii_begin, ii_end, jj_begin, jj_end,             &
    159                             klon_mpi+2*(nbp_lon-1), data_ibegin, data_iend,             &
    160                             io_lat, io_lon,is_south_pole_dyn,mpi_rank)
     143      ! Set values for the mask:
     144      IF (mpi_rank == 0) THEN
     145          data_ibegin = 0
     146      ELSE
     147          data_ibegin = ii_begin - 1
     148      END IF
     149
     150      IF (mpi_rank == mpi_size-1) THEN
     151          data_iend = nbp_lon
     152      ELSE
     153          data_iend = ii_end + 1
     154      END IF
     155
     156      IF (prt_level>=10) THEN
     157        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
     158        write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," nbp_lon=",nbp_lon," nbp_lat=",nbp_lat
     159        write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
     160        write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
     161        write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," is_south_pole_dyn=",is_south_pole_dyn
     162      ENDIF
     163
     164      ! Initialize the XIOS domain coreesponding to this process:
    161165#endif
    162166!$OMP END MASTER
     167
     168#ifdef CPP_XIOS   
     169        CALL wxios_domain_param("dom_glo")
     170#endif
     171     
     172    ENDIF
    163173     
    164174  END SUBROUTINE init_iophy_new
    … …  
    291301                                is_sequential, klon_mpi_begin, klon_mpi_end, &
    292302                                mpi_rank
    293   USE mod_grid_phy_lmdz, ONLY: klon_glo, nbp_lon, nbp_lat
     303  USE mod_grid_phy_lmdz, ONLY: klon_glo, nbp_lon, nbp_lat, grid1dTo2d_glo
    294304  USE ioipsl, ONLY: histbeg
    295305
    … …  
    366376     ENDDO
    367377
    368        CALL gr_fi_ecrit(1,klon,nbp_lon,nbp_lat,rlon_glo,zx_lon)
     378       CALL grid1dTo2d_glo(rlon_glo,zx_lon)
    369379       IF ((nbp_lon*nbp_lat).GT.1) THEN
    370380       DO i = 1, nbp_lon
    … …  
    373383       ENDDO
    374384       ENDIF
    375        CALL gr_fi_ecrit(1,klon,nbp_lon,nbp_lat,rlat_glo,zx_lat)
     385       CALL grid1dTo2d_glo(rlat_glo,zx_lat)
    376386
    377387    DO i=1,pim
    … …  
    963973                                 nid_files, swaerofree_diag, swaero_diag, dryaod_diag, ok_4xCO2atm
    964974  USE print_control_mod, ONLY: prt_level,lunout
    965   USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
     975  USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, unstructured, regular_lonlat
    966976#ifdef CPP_XIOS
    967977  USE xios, ONLY: xios_send_field
    968978#endif
     979  USE print_control_mod, ONLY: lunout, prt_level
    969980
    970981  IMPLICIT NONE
    … …  
    10071018      IF (.not. ok_all_xml) THEN
    10081019      IF (prt_level >= 10) THEN
    1009       WRITE (lunout,*)"histwrite2d_phy: .not.vars_defined ; time to define ", trim(var%name)
     1020      write(lunout,*)"histwrite2d_phy: .not.vars_defined ; time to define ", &
     1021                     trim(var%name)
    10101022      ENDIF
    10111023      DO iff=iff_beg, iff_end
    … …  
    10251037
    10261038    !Et sinon on.... écrit
    1027     IF (SIZE(field)/=klon .AND. SIZE(field)/=klev) CALL abort_physic('iophy::histwrite2d_phy','Field first DIMENSION not equal to klon/klev',1)   
     1039    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)   
    10281040    IF (prt_level >= 10) THEn
    10291041      WRITE (lunout,*)"histwrite2d_phy: .not.vars_defined ; time to gather and write ", trim(var%name)
    … …  
    10371049    ENDIF
    10381050!$OMP MASTER
    1039     CALL grid1Dto2D_mpi(buffer_omp,Field2d)
     1051    IF (grid_type==regular_lonlat) CALL grid1Dto2D_mpi(buffer_omp,Field2d)
    10401052
    10411053! La boucle sur les fichiers:
    … …  
    10471059             write(lunout,*)'Dans iophy histwrite2D,var%name ', trim(var%name)                       
    10481060          ENDIF
    1049           IF (SIZE(field) == klon) then
     1061         
     1062          IF (grid_type==regular_lonlat) THEN
     1063            IF (SIZE(field) == klon) then
    10501064              CALL xios_send_field(var%name, Field2d)
    1051           ELSE
    1052              CALL xios_send_field(var%name, field)
    1053           ENDIF
     1065            ELSE
     1066               CALL xios_send_field(var%name, field)
     1067            ENDIF
     1068          ELSE IF (grid_type==unstructured) THEN
     1069            IF (SIZE(field) == klon) then
     1070              CALL xios_send_field(var%name, buffer_omp)
     1071            ELSE
     1072               CALL xios_send_field(var%name, field)
     1073            ENDIF
     1074
     1075          ENDIF
    10541076          IF (prt_level >= 10) THEN
    1055              WRITE (lunout,*)'Dans iophy histwrite2D,var%name apres xios_send ', trim(var%name)                       
     1077             write(lunout,*)'Dans iophy histwrite2D,var%name apres xios_send ',&
     1078                             trim(var%name)                       
    10561079          ENDIF
    10571080#else
    … …  
    10651088               IF (firstx) THEN
    10661089                  IF (prt_level >= 10) THEN
    1067                      WRITE (lunout,*)'Dans iophy histwrite2D,iff,var%name ', iff,trim(var%name)                       
    1068                      WRITE (lunout,*)"histwrite2d_phy:.NOT.clef_stations(iff)and iff==iff_beg, call xios_send_field"
     1090                     write(lunout,*)'Dans iophy histwrite2D,iff,var%name ',&
     1091                                    iff,trim(var%name)                       
     1092                     write(lunout,*)"histwrite2d_phy:.NOT.clef_stations(iff)and iff==iff_beg, call xios_send_field"
    10691093                  ENDIF
    1070                   IF (SIZE(field) == klon) then
    1071                      CALL xios_send_field(var%name, Field2d)
    1072                   ELSE
    1073                      CALL xios_send_field(var%name, field)
     1094                  IF (grid_type==regular_lonlat) THEN
     1095                    IF (SIZE(field) == klon) then
     1096                       CALL xios_send_field(var%name, Field2d)
     1097                    ELSE
     1098                       CALL xios_send_field(var%name, field)
     1099                    ENDIF
     1100                  ELSE IF (grid_type==unstructured) THEN
     1101                    IF (SIZE(field) == klon) then
     1102                      CALL xios_send_field(var%name, buffer_omp)
     1103                    ELSE
     1104                      CALL xios_send_field(var%name, field)
     1105                    ENDIF
    10741106                  ENDIF
     1107
    10751108                  firstx=.false.
    10761109               ENDIF
    … …  
    10851118!#ifdef CPP_XIOS
    10861119!                        IF (iff == iff_beg) THEN
    1087 !                          if (prt_level >= 10) then
     1120!                          IF (prt_level >= 10) THEN
    10881121!                            write(lunout,*)"histwrite2d_phy: .NOT.clef_stations(iff) and iff==iff_beg, call xios_send_field"
    1089 !                          endif
     1122!                          ENDIF
    10901123!                          CALL xios_send_field(var%name, Field2d)
    10911124!                        ENDIF
    … …  
    11091142                       ENDIF ! of IF (is_sequential)
    11101143#ifndef CPP_IOIPSL_NO_OUTPUT
    1111                        IF (prt_level >= 10) THEn
     1144                       IF (prt_level >= 10) THEN
    11121145                         write(lunout,*)"histwrite2d_phy: clef_stations(iff) and iff==iff_beg, call wxios_write_2D"
    11131146                       ENDIF
    … …  
    11411174                                 nfiles, vars_defined, clef_stations, &
    11421175                                 nid_files, swaerofree_diag
    1143   USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
     1176  USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, regular_lonlat, unstructured
    11441177#ifdef CPP_XIOS
    11451178  USE xios, ONLY: xios_send_field
    … …  
    11911224    !Et sinon on.... écrit
    11921225
    1193     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)
     1226    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)
    11941227
    11951228    nlev=SIZE(field,2)
    … …  
    12061239    ENDIF
    12071240!$OMP MASTER
    1208     CALL grid1Dto2D_mpi(buffer_omp,field3d)
     1241    IF (grid_type==regular_lonlat) CALL grid1Dto2D_mpi(buffer_omp,field3d)
    12091242
    12101243! BOUCLE SUR LES FICHIERS
    … …  
    12131246    IF (ok_all_xml) THEN
    12141247#ifdef CPP_XIOS
    1215         IF (prt_level >= 10) THEN
    1216              write(lunout,*)'Dans iophy histwrite3D,var%name ',trim(var%name)                       
     1248          IF (prt_level >= 10) THEN
     1249             write(lunout,*)'Dans iophy histwrite3D,var%name ',&
     1250                             trim(var%name)                       
     1251          ENDIF
     1252          IF (grid_type==regular_lonlat) THEN
     1253            IF (SIZE(field,1) == klon) then
     1254               CALL xios_send_field(var%name, Field3d(:,:,1:nlevx))
     1255            ELSE
     1256               CALL xios_send_field(var%name, field)
     1257            ENDIF
     1258          ELSE IF (grid_type==unstructured) THEN
     1259            IF (SIZE(field,1) == klon) then
     1260               CALL xios_send_field(var%name, buffer_omp(:,1:nlevx))
     1261            ELSE
     1262               CALL xios_send_field(var%name, field)
     1263            ENDIF
    12171264        ENDIF
    1218         IF (SIZE(field,1) == klon) then
    1219              CALL xios_send_field(var%name, Field3d(:,:,1:nlevx))
    1220         ELSE
    1221              CALL xios_send_field(var%name, field)
    1222         ENDIF
     1265
    12231266#else
    12241267        CALL abort_physic ('iophy','cannot have ok_all_xml = .T. without CPP_XIOS defined' ,1)
    … …  
    12301273#ifdef CPP_XIOS
    12311274              IF (firstx) THEN
    1232                 IF (prt_level >= 10) THEn
    1233                   WRITE (lunout,*)'Dans iophy, histwrite3D iff nlev klev firstx', &
     1275                IF (prt_level >= 10) THEN
     1276                  write(lunout,*)'Dans iophy, histwrite3D iff nlev klev firstx', &
    12341277                                  iff,nlev,klev, firstx                       
    1235                   WRITE (lunout,*)'histwrite3d_phy: call xios_send_field for ', &
     1278                  write(lunout,*)'histwrite3d_phy: call xios_send_field for ', &
    12361279                                  trim(var%name), ' with iim jjm nlevx = ', &
    12371280                                  nbp_lon,jj_nb,nlevx
    12381281                ENDIF
    1239                 IF (SIZE(field,1) == klon) then
    1240                     CALL xios_send_field(var%name, Field3d(:,:,1:nlevx))
    1241                 ELSE
     1282                IF (grid_type==regular_lonlat) THEN
     1283                  IF (SIZE(field,1) == klon) then
     1284                      CALL xios_send_field(var%name, Field3d(:,:,1:nlevx))
     1285                  ELSE
     1286                       CALL xios_send_field(var%name, field)
     1287                  ENDIF
     1288                ELSE IF (grid_type==unstructured) THEN
     1289                  IF (SIZE(field,1) == klon) then
     1290                     CALL xios_send_field(var%name, buffer_omp(:,1:nlevx))
     1291                  ELSE
    12421292                     CALL xios_send_field(var%name, field)
     1293                  ENDIF
    12431294                ENDIF
     1295
    12441296                firstx=.false.
    12451297              ENDIF
    … …  
    13051357                                is_sequential, klon_mpi_begin, klon_mpi_end, &
    13061358                                jj_nb, klon_mpi, is_master
    1307   USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
     1359  USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, unstructured
    13081360  USE xios, ONLY: xios_send_field
    13091361  USE print_control_mod, ONLY: prt_level,lunout
    … …  
    13251377  IF (prt_level >= 10) WRITE(lunout,*)'Begin histrwrite2d_xios ',field_name
    13261378
    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
     1379    !Et sinon on.... écrit
     1380    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)
     1381    IF (SIZE(field) == klev .OR. SIZE(field) == klev+1) then
    13311382!$OMP MASTER
     1383
    13321384        CALL xios_send_field(field_name,field)
    13331385!$OMP END MASTER   
    … …  
    13351387        CALL Gather_omp(field,buffer_omp)   
    13361388!$OMP MASTER
     1389
     1390      IF (grid_type==unstructured) THEN
     1391 
     1392        CALL xios_send_field(field_name, buffer_omp)
     1393
     1394      ELSE
     1395
    13371396        CALL grid1Dto2D_mpi(buffer_omp,Field2d)
    13381397   
    … …  
    13421401    !IF(.NOT.clef_stations(iff)) THEN
    13431402        IF (.TRUE.) THEN
    1344             ALLOCATE(index2d(nbp_lon*jj_nb))
    1345             ALLOCATE(fieldok(nbp_lon*jj_nb))
    1346    
    13471403   
    13481404            CALL xios_send_field(field_name, Field2d)
    … …  
    13651421                ENDDO
    13661422            ENDIF
    1367    
    1368         ENDIF
    1369                  
    1370         DEALLOCATE(index2d)
    1371         DEALLOCATE(fieldok)
     1423            DEALLOCATE(index2d)
     1424            DEALLOCATE(fieldok)
     1425   
     1426        ENDIF                 
     1427      ENDIF
    13721428!$OMP END MASTER   
    13731429  ENDIF
    … …  
    13851441                                jj_nb, klon_mpi, is_master
    13861442  USE xios, ONLY: xios_send_field
    1387   USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
     1443  USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, unstructured
    13881444  USE print_control_mod, ONLY: prt_level,lunout
    13891445
    … …  
    14031459  IF (prt_level >= 10) write(lunout,*)'Begin histrwrite3d_xios ',field_name
    14041460
    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
     1461    !Et on.... écrit
     1462    IF (SIZE(field,1)/=klon .AND. SIZE(field,1)/=klev .AND. SIZE(field,1)/=klev+1) then
     1463      write(lunout,*)' histrwrite3d_xios ', field_name, SIZE(field)
     1464      CALL abort_physic('iophy::histwrite3d_xios','Field first DIMENSION not equal to klon/klev',1)
     1465    ENDIF
     1466   
     1467    IF (SIZE(field,1) == klev .OR. SIZE(field,1) == klev+1) then
    14091468!$OMP MASTER
    14101469        CALL xios_send_field(field_name,field)
    … …  
    14161475        CALL Gather_omp(field,buffer_omp)
    14171476!$OMP MASTER
     1477
     1478    IF (grid_type==unstructured) THEN
     1479
     1480      CALL xios_send_field(field_name, buffer_omp(:,1:nlev))
     1481
     1482    ELSE
    14181483        CALL grid1Dto2D_mpi(buffer_omp,field3d)
    14191484
    … …  
    14231488    !IF (.NOT.clef_stations(iff)) THEN
    14241489        IF(.TRUE.)THEN
    1425             ALLOCATE(index3d(nbp_lon*jj_nb*nlev))
    1426             ALLOCATE(fieldok(nbp_lon*jj_nb,nlev))
    1427             CALL xios_send_field(field_name, Field3d(:,:,1:nlev))
     1490
     1491           CALL xios_send_field(field_name, Field3d(:,:,1:nlev))
    14281492                           
    14291493        ELSE
    … …  
    14481512                ENDDO
    14491513            ENDIF
     1514            DEALLOCATE(index3d)
     1515            DEALLOCATE(fieldok)
    14501516        ENDIF
    1451         DEALLOCATE(index3d)
    1452         DEALLOCATE(fieldok)
     1517      ENDIF
    14531518!$OMP END MASTER   
    14541519  ENDIF
Note: See TracChangeset for help on using the changeset viewer.