Ignore:
Timestamp:
Oct 3, 2017, 4:45:26 PM (7 years ago)
Author:
Laurent Fairhead
Message:

Modifications to the code and xml files to output Ap and B, the coefficients
of the hybrid coordinates as requested by the CMIP6 DataRequest?
LF (with guidance from A. Caubel and S. Senesi)

File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r2989 r3003  
    921921! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
    922922  SUBROUTINE histwrite2d_phy(var,field, STD_iff)
    923   USE dimphy, ONLY: klon
     923  USE dimphy, ONLY: klon, klev
    924924  USE mod_phys_lmdz_para, ONLY: gather_omp, grid1dto2d_mpi, &
    925925                                jj_nb, klon_mpi, klon_mpi_begin, &
    … …  
    984984
    985985    !Et sinon on.... écrit
    986     IF (SIZE(field)/=klon) CALL abort_physic('iophy::histwrite2d_phy','Field first DIMENSION not equal to klon',1)
    987    
     986    IF (SIZE(field)/=klon .AND. SIZE(field)/=klev) CALL abort_physic('iophy::histwrite2d_phy','Field first DIMENSION not equal to klon/klev',1)   
    988987    IF (prt_level >= 10) THEn
    989988      WRITE (lunout,*)"histwrite2d_phy: .not.vars_defined ; time to gather and write ", trim(var%name)
    990989    ENDIF
    991990   
    992     CALL Gather_omp(field,buffer_omp)
     991   
     992    IF (SIZE(field) == klon) then
     993        CALL Gather_omp(field,buffer_omp)
     994    ELSE
     995        buffer_omp(:)=0.
     996    ENDIF
    993997!$OMP MASTER
    994998    CALL grid1Dto2D_mpi(buffer_omp,Field2d)
    … …  
    10021006             write(lunout,*)'Dans iophy histwrite2D,var%name ', trim(var%name)                       
    10031007          ENDIF
    1004           CALL xios_send_field(var%name, Field2d)
     1008          IF (SIZE(field) == klon) then
     1009              CALL xios_send_field(var%name, Field2d)
     1010          ELSE
     1011             CALL xios_send_field(var%name, field)
     1012          ENDIF
    10051013          IF (prt_level >= 10) THEN
    10061014             WRITE (lunout,*)'Dans iophy histwrite2D,var%name apres xios_send ', trim(var%name)                       
    … …  
    10191027                     WRITE (lunout,*)"histwrite2d_phy:.NOT.clef_stations(iff)and iff==iff_beg, call xios_send_field"
    10201028                  ENDIF
    1021                   CALL xios_send_field(var%name, Field2d)
     1029                  IF (SIZE(field) == klon) then
     1030                     CALL xios_send_field(var%name, Field2d)
     1031                  ELSE
     1032                     CALL xios_send_field(var%name, field)
     1033                  ENDIF
    10221034                  firstx=.false.
    10231035               ENDIF
    … …  
    11291141  ELSE
    11301142    !Et sinon on.... écrit
    1131     IF (SIZE(field,1)/=klon) CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)
     1143
     1144    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)
     1145
    11321146    nlev=SIZE(field,2)
    11331147    IF (nlev.EQ.klev+1) THEN
    … …  
    11371151    ENDIF
    11381152
    1139     CALL Gather_omp(field,buffer_omp)
     1153    IF (SIZE(field,1) == klon) then
     1154        CALL Gather_omp(field,buffer_omp)
     1155    ELSE
     1156        buffer_omp(:,:)=0.
     1157    ENDIF
    11401158!$OMP MASTER
    11411159    CALL grid1Dto2D_mpi(buffer_omp,field3d)
    … …  
    11511169                             trim(var%name)                       
    11521170          ENDIF
    1153           CALL xios_send_field(var%name, Field3d(:,:,1:nlevx))
     1171          IF (SIZE(field,1) == klon) then
     1172             CALL xios_send_field(var%name, Field3d(:,:,1:nlevx))
     1173          ELSE
     1174             CALL xios_send_field(var%name, field)
     1175          ENDIF
    11541176#else
    11551177        CALL abort_physic ('iophy','cannot have ok_all_xml = .T. without CPP_XIOS defined' ,1)
    … …  
    11691191                                  nbp_lon,jj_nb,nlevx
    11701192                ENDIF
    1171                 CALL xios_send_field(var%name, Field3d(:,:,1:nlevx))
    1172                             firstx=.false.
     1193                IF (SIZE(field,1) == klon) then
     1194                    CALL xios_send_field(var%name, Field3d(:,:,1:nlevx))
     1195                ELSE
     1196                     CALL xios_send_field(var%name, field)
     1197                ENDIF
     1198                firstx=.false.
    11731199              ENDIF
    11741200#endif
    … …  
    12261252#ifdef CPP_XIOS
    12271253  SUBROUTINE histwrite2d_xios(field_name,field)
    1228   USE dimphy, ONLY: klon
     1254  USE dimphy, ONLY: klon, klev
    12291255  USE mod_phys_lmdz_para, ONLY: gather_omp, grid1Dto2D_mpi, &
    12301256                                is_sequential, klon_mpi_begin, klon_mpi_end, &
    … …  
    12491275
    12501276    !Et sinon on.... écrit
    1251     IF (SIZE(field)/=klon) CALL abort_physic('iophy::histwrite2d_xios','Field first DIMENSION not equal to klon',1)
    1252    
    1253     CALL Gather_omp(field,buffer_omp)   
     1277    IF (SIZE(field)/=klon .AND. SIZE(field)/=klev) CALL abort_physic('iophy::histwrite2d_xios','Field first DIMENSION not equal to klon/klev',1)
     1278   
     1279    IF (SIZE(field) == klev) then
    12541280!$OMP MASTER
    1255     CALL grid1Dto2D_mpi(buffer_omp,Field2d)
     1281        CALL xios_send_field(field_name,field)
     1282!$OMP END MASTER   
     1283    ELSE
     1284        CALL Gather_omp(field,buffer_omp)   
     1285!$OMP MASTER
     1286        CALL grid1Dto2D_mpi(buffer_omp,Field2d)
    12561287   
    12571288!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    12591290!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    12601291    !IF(.NOT.clef_stations(iff)) THEN
    1261     IF (.TRUE.) THEN
    1262         ALLOCATE(index2d(nbp_lon*jj_nb))
    1263         ALLOCATE(fieldok(nbp_lon*jj_nb))
    1264 
    1265 
    1266         CALL xios_send_field(field_name, Field2d)
    1267 
    1268     ELSE
    1269         ALLOCATE(fieldok(npstn))
    1270         ALLOCATE(index2d(npstn))
    1271 
    1272         IF (is_sequential) THEN
    1273             DO ip=1, npstn
    1274                 fieldok(ip)=buffer_omp(nptabij(ip))
    1275             ENDDO
    1276         ELSE
    1277             DO ip=1, npstn
    1278                 PRINT*,'histwrite2d_xios is_sequential npstn ip namenptabij',npstn,ip,field_name,nptabij(ip)
    1279                 IF(nptabij(ip).GE.klon_mpi_begin.AND. &
    1280                 nptabij(ip).LE.klon_mpi_end) THEN
    1281                     fieldok(ip)=buffer_omp(nptabij(ip)-klon_mpi_begin+1)
    1282                 ENDIF
    1283             ENDDO
     1292        IF (.TRUE.) THEN
     1293            ALLOCATE(index2d(nbp_lon*jj_nb))
     1294            ALLOCATE(fieldok(nbp_lon*jj_nb))
     1295   
     1296   
     1297            CALL xios_send_field(field_name, Field2d)
     1298   
     1299        ELSE
     1300            ALLOCATE(fieldok(npstn))
     1301            ALLOCATE(index2d(npstn))
     1302   
     1303            IF (is_sequential) THEN
     1304                DO ip=1, npstn
     1305                    fieldok(ip)=buffer_omp(nptabij(ip))
     1306                ENDDO
     1307            ELSE
     1308                DO ip=1, npstn
     1309                    PRINT*,'histwrite2d_xios is_sequential npstn ip namenptabij',npstn,ip,field_name,nptabij(ip)
     1310                    IF(nptabij(ip).GE.klon_mpi_begin.AND. &
     1311                    nptabij(ip).LE.klon_mpi_end) THEN
     1312                        fieldok(ip)=buffer_omp(nptabij(ip)-klon_mpi_begin+1)
     1313                    ENDIF
     1314                ENDDO
     1315            ENDIF
     1316   
    12841317        ENDIF
    1285 
    1286     ENDIF
    12871318                 
    1288     DEALLOCATE(index2d)
    1289     DEALLOCATE(fieldok)
     1319        DEALLOCATE(index2d)
     1320        DEALLOCATE(fieldok)
    12901321!$OMP END MASTER   
     1322    ENDIF
    12911323
    12921324  IF (prt_level >= 10) WRITE(lunout,*)'End histrwrite2d_xios ',field_name
    … …  
    13181350
    13191351    !Et on.... écrit
    1320     IF (SIZE(field,1)/=klon) CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)
    1321     nlev=SIZE(field,2)
    1322 
    1323 
    1324     CALL Gather_omp(field,buffer_omp)
     1352    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)
     1353   
     1354    IF (SIZE(field,1) == klev) then
    13251355!$OMP MASTER
    1326     CALL grid1Dto2D_mpi(buffer_omp,field3d)
     1356        CALL xios_send_field(field_name,field)
     1357!$OMP END MASTER   
     1358    ELSE
     1359        nlev=SIZE(field,2)
     1360
     1361
     1362        CALL Gather_omp(field,buffer_omp)
     1363!$OMP MASTER
     1364        CALL grid1Dto2D_mpi(buffer_omp,field3d)
    13271365
    13281366!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    13301368!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    13311369    !IF (.NOT.clef_stations(iff)) THEN
    1332     IF(.TRUE.)THEN
    1333         ALLOCATE(index3d(nbp_lon*jj_nb*nlev))
    1334         ALLOCATE(fieldok(nbp_lon*jj_nb,nlev))
    1335         CALL xios_send_field(field_name, Field3d(:,:,1:nlev))
    1336                        
    1337     ELSE
    1338         nlev=size(field,2)
    1339         ALLOCATE(index3d(npstn*nlev))
    1340         ALLOCATE(fieldok(npstn,nlev))
    1341 
    1342         IF (is_sequential) THEN
    1343             DO n=1, nlev
    1344                 DO ip=1, npstn
    1345                     fieldok(ip,n)=buffer_omp(nptabij(ip),n)
     1370        IF(.TRUE.)THEN
     1371            ALLOCATE(index3d(nbp_lon*jj_nb*nlev))
     1372            ALLOCATE(fieldok(nbp_lon*jj_nb,nlev))
     1373            CALL xios_send_field(field_name, Field3d(:,:,1:nlev))
     1374                           
     1375        ELSE
     1376            nlev=size(field,2)
     1377            ALLOCATE(index3d(npstn*nlev))
     1378            ALLOCATE(fieldok(npstn,nlev))
     1379   
     1380            IF (is_sequential) THEN
     1381                DO n=1, nlev
     1382                    DO ip=1, npstn
     1383                        fieldok(ip,n)=buffer_omp(nptabij(ip),n)
     1384                    ENDDO
    13461385                ENDDO
    1347             ENDDO
    1348         ELSE
    1349             DO n=1, nlev
    1350                 DO ip=1, npstn
    1351                     IF(nptabij(ip).GE.klon_mpi_begin.AND. &
    1352                     nptabij(ip).LE.klon_mpi_end) THEN
    1353                         fieldok(ip,n)=buffer_omp(nptabij(ip)-klon_mpi_begin+1,n)
    1354                     ENDIF
     1386            ELSE
     1387                DO n=1, nlev
     1388                    DO ip=1, npstn
     1389                        IF(nptabij(ip).GE.klon_mpi_begin.AND. &
     1390                        nptabij(ip).LE.klon_mpi_end) THEN
     1391                            fieldok(ip,n)=buffer_omp(nptabij(ip)-klon_mpi_begin+1,n)
     1392                        ENDIF
     1393                    ENDDO
    13551394                ENDDO
    1356             ENDDO
    1357         ENDIF
    1358     ENDIF
    1359     DEALLOCATE(index3d)
    1360     DEALLOCATE(fieldok)
     1395            ENDIF
     1396        ENDIF
     1397        DEALLOCATE(index3d)
     1398        DEALLOCATE(fieldok)
    13611399!$OMP END MASTER   
     1400    ENDIF
    13621401
    13631402  IF (prt_level >= 10) write(lunout,*)'End histrwrite3d_xios ',field_name
Note: See TracChangeset for help on using the changeset viewer.