Changeset 3003 for LMDZ5/trunk/libf/phylmd
- Timestamp:
- Oct 3, 2017, 4:45:26 PM (7 years ago)
- Location:
- LMDZ5/trunk/libf/phylmd
- Files:
-
- 4 edited
-
iophy.F90 (modified) (13 diffs)
-
phys_output_ctrlout_mod.F90 (modified) (1 diff)
-
phys_output_mod.F90 (modified) (3 diffs)
-
phys_output_write_mod.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/trunk/libf/phylmd/iophy.F90
r2989 r3003 921 921 ! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE 922 922 SUBROUTINE histwrite2d_phy(var,field, STD_iff) 923 USE dimphy, ONLY: klon 923 USE dimphy, ONLY: klon, klev 924 924 USE mod_phys_lmdz_para, ONLY: gather_omp, grid1dto2d_mpi, & 925 925 jj_nb, klon_mpi, klon_mpi_begin, & … … 984 984 985 985 !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) 988 987 IF (prt_level >= 10) THEn 989 988 WRITE (lunout,*)"histwrite2d_phy: .not.vars_defined ; time to gather and write ", trim(var%name) 990 989 ENDIF 991 990 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 993 997 !$OMP MASTER 994 998 CALL grid1Dto2D_mpi(buffer_omp,Field2d) … … 1002 1006 write(lunout,*)'Dans iophy histwrite2D,var%name ', trim(var%name) 1003 1007 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 1005 1013 IF (prt_level >= 10) THEN 1006 1014 WRITE (lunout,*)'Dans iophy histwrite2D,var%name apres xios_send ', trim(var%name) … … 1019 1027 WRITE (lunout,*)"histwrite2d_phy:.NOT.clef_stations(iff)and iff==iff_beg, call xios_send_field" 1020 1028 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 1022 1034 firstx=.false. 1023 1035 ENDIF … … 1129 1141 ELSE 1130 1142 !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 1132 1146 nlev=SIZE(field,2) 1133 1147 IF (nlev.EQ.klev+1) THEN … … 1137 1151 ENDIF 1138 1152 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 1140 1158 !$OMP MASTER 1141 1159 CALL grid1Dto2D_mpi(buffer_omp,field3d) … … 1151 1169 trim(var%name) 1152 1170 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 1154 1176 #else 1155 1177 CALL abort_physic ('iophy','cannot have ok_all_xml = .T. without CPP_XIOS defined' ,1) … … 1169 1191 nbp_lon,jj_nb,nlevx 1170 1192 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. 1173 1199 ENDIF 1174 1200 #endif … … 1226 1252 #ifdef CPP_XIOS 1227 1253 SUBROUTINE histwrite2d_xios(field_name,field) 1228 USE dimphy, ONLY: klon 1254 USE dimphy, ONLY: klon, klev 1229 1255 USE mod_phys_lmdz_para, ONLY: gather_omp, grid1Dto2D_mpi, & 1230 1256 is_sequential, klon_mpi_begin, klon_mpi_end, & … … 1249 1275 1250 1276 !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 1254 1280 !$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) 1256 1287 1257 1288 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! … … 1259 1290 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1260 1291 !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 1284 1317 ENDIF 1285 1286 ENDIF1287 1318 1288 DEALLOCATE(index2d)1289 DEALLOCATE(fieldok)1319 DEALLOCATE(index2d) 1320 DEALLOCATE(fieldok) 1290 1321 !$OMP END MASTER 1322 ENDIF 1291 1323 1292 1324 IF (prt_level >= 10) WRITE(lunout,*)'End histrwrite2d_xios ',field_name … … 1318 1350 1319 1351 !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 1325 1355 !$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) 1327 1365 1328 1366 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! … … 1330 1368 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1331 1369 !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 1346 1385 ENDDO 1347 E NDDO1348 ELSE1349 DO n=1, nlev1350 DO ip=1, npstn1351 IF(nptabij(ip).GE.klon_mpi_begin.AND. &1352 nptabij(ip).LE.klon_mpi_end) THEN1353 fieldok(ip,n)=buffer_omp(nptabij(ip)-klon_mpi_begin+1,n)1354 END IF1386 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 1355 1394 ENDDO 1356 ENDDO 1357 ENDIF 1358 ENDIF 1359 DEALLOCATE(index3d) 1360 DEALLOCATE(fieldok) 1395 ENDIF 1396 ENDIF 1397 DEALLOCATE(index3d) 1398 DEALLOCATE(fieldok) 1361 1399 !$OMP END MASTER 1400 ENDIF 1362 1401 1363 1402 IF (prt_level >= 10) write(lunout,*)'End histrwrite3d_xios ',field_name -
LMDZ5/trunk/libf/phylmd/phys_output_ctrlout_mod.F90
r3002 r3003 18 18 19 19 !!! Comosantes de la coordonnee sigma-hybride 20 !!! Ap et Bp 20 !!! Ap et Bp et interfaces 21 21 TYPE(ctrl_out), SAVE :: o_Ahyb = ctrl_out((/ 1, 1, 1, 1, 1, 1, 11, 11, 11, 11/), & 22 'A p', '', '', (/ ('', i=1, 10) /))22 'Ahyb', '', '', (/ ('once', i=1, 10) /)) 23 23 TYPE(ctrl_out), SAVE :: o_Bhyb = ctrl_out((/ 1, 1, 1, 1, 1, 1, 11, 11, 11, 11/), & 24 'Bp', '', '', (/ ('', i=1, 10) /)) 24 'Bhyb', '', '', (/ ('once', i=1, 10) /)) 25 TYPE(ctrl_out), SAVE :: o_Ahyb_inter = ctrl_out((/ 1, 1, 1, 1, 1, 1, 11, 11, 11, 11/), & 26 'Ahyb_inter', '', '', (/ ('once', i=1, 10) /)) 27 TYPE(ctrl_out), SAVE :: o_Bhyb_inter = ctrl_out((/ 1, 1, 1, 1, 1, 1, 11, 11, 11, 11/), & 28 'Bhyb_inter', '', '', (/ ('once', i=1, 10) /)) 25 29 TYPE(ctrl_out), SAVE :: o_Alt = ctrl_out((/ 1, 1, 1, 1, 1, 1, 11, 11, 11, 11/), & 26 30 'Alt', '', '', (/ ('', i=1, 10) /)) -
LMDZ5/trunk/libf/phylmd/phys_output_mod.F90
r2989 r3003 126 126 -90., -90., -90., -90., -90. /) 127 127 REAL, DIMENSION(nfiles), SAVE :: phys_out_latmax = (/ 90., 90., 90., 90., 90., & 128 90., 90., 90., 90., 90. /) 128 90., 90., 90., 90., 90. /) 129 REAL, DIMENSION(klev,2) :: Ahyb_bounds, Bhyb_bounds 130 REAL, DIMENSION(klev) :: lev_index 131 129 132 #ifdef CPP_XIOS 130 133 ! ug Variables utilis\'ees pour r\'ecup\'erer le calendrier pour xios … … 137 140 WRITE(lunout,*) 'Debut phys_output_mod.F90' 138 141 ! Initialisations (Valeurs par defaut 142 143 DO ilev=1,klev 144 Ahyb_bounds(ilev,1) = ap(ilev) 145 Ahyb_bounds(ilev,2) = ap(ilev+1) 146 Bhyb_bounds(ilev,1) = bp(ilev) 147 Bhyb_bounds(ilev,2) = bp(ilev+1) 148 lev_index(ilev) = REAL(ilev) 149 END DO 139 150 140 151 IF (.NOT. ALLOCATED(o_trac)) ALLOCATE(o_trac(nqtot)) … … 327 338 print*,'phys_output_open: Declare vertical axes for each file' 328 339 ENDIF 340 329 341 IF (iff.LE.6.OR.iff.EQ.10) THEN 330 342 CALL wxios_add_vaxis("presnivs", & 331 343 levmax(iff) - levmin(iff) + 1, presnivs(levmin(iff):levmax(iff))) 332 344 CALL wxios_add_vaxis("Ahyb", & 333 levmax(iff) - levmin(iff) + 1, aps) 345 levmax(iff) - levmin(iff) + 1, aps(levmin(iff):levmax(iff)), positif='down', & 346 bnds=Ahyb_bounds(levmin(iff):levmax(iff),:)) 334 347 CALL wxios_add_vaxis("Bhyb", & 335 levmax(iff) - levmin(iff) + 1, bps) 336 CALL wxios_add_vaxis("Alt", & 348 levmax(iff) - levmin(iff) + 1, bps(levmin(iff):levmax(iff)), positif='down', & 349 bnds=Bhyb_bounds(levmin(iff):levmax(iff),:)) 350 CALL wxios_add_vaxis("klev", levmax(iff) - levmin(iff) + 1, & 351 lev_index(levmin(iff):levmax(iff))) 352 CALL wxios_add_vaxis("bnds", 2, (/1.,2./)) 353 354 CALL wxios_add_vaxis("Alt", & 337 355 levmax(iff) - levmin(iff) + 1, pseudoalt) 338 356 ELSE -
LMDZ5/trunk/libf/phylmd/phys_output_write_mod.F90
r3002 r3003 29 29 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat 30 30 USE time_phylmdz_mod, ONLY: day_step_phy, start_time, itau_phy 31 USE vertical_layers_mod, ONLY : ap, bp, aps, bps 31 32 USE phys_output_ctrlout_mod, ONLY: o_phis, o_aire, is_ter, is_lic, is_oce, & 33 o_Ahyb, o_Bhyb,o_Ahyb_inter, o_Bhyb_inter, & 32 34 is_ave, is_sic, o_contfracATM, o_contfracOR, & 33 35 o_aireTER, o_flat, o_slp, o_ptstar, o_pt0, o_tsol, & … … 392 394 REAL, PARAMETER :: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2 393 395 ! REAL, PARAMETER :: missing_val=nf90_fill_real 396 REAL, DIMENSION(klev,2) :: Ahyb_bounds, Bhyb_bounds 397 INTEGER :: ilev 394 398 #ifndef CPP_XIOS 395 399 REAL :: missing_val … … 418 422 iinitend = 1 419 423 ENDIF 424 425 DO ilev=1,klev 426 Ahyb_bounds(ilev,1) = ap(ilev) 427 Ahyb_bounds(ilev,2) = ap(ilev+1) 428 Bhyb_bounds(ilev,1) = bp(ilev) 429 Bhyb_bounds(ilev,2) = bp(ilev+1) 430 END DO 420 431 421 432 #ifdef CPP_XIOS … … 531 542 CALL histwrite_phy("R_incl",R_incl) 532 543 CALL histwrite_phy("solaire",solaire) 544 CALL histwrite_phy(o_Ahyb, aps) 545 CALL histwrite_phy(o_Bhyb, bps) 546 CALL histwrite_phy(o_Ahyb_inter, Ahyb_bounds) 547 CALL histwrite_phy(o_Bhyb_inter, Bhyb_bounds) 533 548 ! 534 549 #ifdef CPP_RRTM
Note: See TracChangeset
for help on using the changeset viewer.
