Changeset 1378 for IOIPSL/trunk/src/flincom.f90
- Timestamp:
- 04/20/11 12:08:00 (13 years ago)
- File:
-
- 1 edited
-
IOIPSL/trunk/src/flincom.f90 (modified) (40 diffs)
Legend:
- Unmodified
- Added
- Removed
-
IOIPSL/trunk/src/flincom.f90
r1377 r1378 9 9 !- 10 10 USE calendar, ONLY : ju2ymds, ymds2ju, ioconf_calendar 11 USE errioipsl, ONLY : histerr 11 USE errioipsl, ONLY : histerr, ipslout 12 12 USE stringop, ONLY : strlowercase 13 13 !- … … 193 193 ! Vertical axis 194 194 !- 195 IF (check) WRITE( *,*) 'flincre Vertical axis'195 IF (check) WRITE(ipslout,*) 'flincre Vertical axis' 196 196 !- 197 197 iret = NF90_DEF_VAR (fid, 'lev', NF90_FLOAT, zdimid1, levid) … … 202 202 ! Time axis 203 203 !- 204 IF (check) WRITE( *,*) 'flincre time axis'204 IF (check) WRITE(ipslout,*) 'flincre time axis' 205 205 !- 206 206 iret = NF90_DEF_VAR (fid, 'tstep', NF90_FLOAT, tdimid1, timeid) … … 211 211 ! The longitude 212 212 !- 213 IF (check) WRITE( *,*) 'flincre Longitude axis'213 IF (check) WRITE(ipslout,*) 'flincre Longitude axis' 214 214 !- 215 215 iret = NF90_DEF_VAR (fid, "nav_lon", NF90_FLOAT, & … … 226 226 ! The Latitude 227 227 !- 228 IF (check) WRITE( *,*) 'flincre Latitude axis'228 IF (check) WRITE(ipslout,*) 'flincre Latitude axis' 229 229 !- 230 230 iret = NF90_DEF_VAR (fid, "nav_lat", NF90_FLOAT, & … … 253 253 iret = NF90_ENDDEF (fid) 254 254 !- 255 IF (check) WRITE( *,*) 'flincre Variable'255 IF (check) WRITE(ipslout,*) 'flincre Variable' 256 256 !- 257 257 iret = NF90_PUT_VAR (fid, levid, lev1(1:llm1)) 258 258 !- 259 IF (check) WRITE( *,*) 'flincre Time Variable'259 IF (check) WRITE(ipslout,*) 'flincre Time Variable' 260 260 !- 261 261 iret = NF90_PUT_VAR (fid, timeid, REAL(itaus(1:ttm1))) 262 262 !- 263 IF (check) WRITE( *,*) 'flincre Longitude'263 IF (check) WRITE(ipslout,*) 'flincre Longitude' 264 264 !- 265 265 iret = NF90_PUT_VAR (fid, lonid, lon1(1:iim1,1:jjm1)) 266 266 !- 267 IF (check) WRITE( *,*) 'flincre Latitude'267 IF (check) WRITE(ipslout,*) 'flincre Latitude' 268 268 !- 269 269 iret = NF90_PUT_VAR (fid, latid, lat1(1:iim1,1:jjm1)) … … 423 423 !- 424 424 IF (check) & 425 WRITE( *,*) 'OUT OF flininfo :',tmp_iim,tmp_jjm,tmp_llm,tmp_ttm425 WRITE(ipslout,*) 'OUT OF flininfo :',tmp_iim,tmp_jjm,tmp_llm,tmp_ttm 426 426 !- 427 427 fid = ncids(fid_out) … … 433 433 !- 434 434 IF (check) & 435 WRITE( *,*) 'flininfo 2.2 We test if we have to test : ',do_test435 WRITE(ipslout,*) 'flininfo 2.2 We test if we have to test : ',do_test 436 436 !- 437 437 IF (do_test) THEN … … 453 453 !-- 2.3 Else the sizes of the axes are returned to the user 454 454 !--- 455 IF (check) WRITE( *,*) 'flinopen 2.3 Else sizes are returned'455 IF (check) WRITE(ipslout,*) 'flinopen 2.3 Else sizes are returned' 456 456 !--- 457 457 iim = tmp_iim … … 465 465 ! if not then we get the lon, lat and lev variables from the file 466 466 !- 467 IF (check) WRITE( *,*) 'flinopen 3.0 we are realy talking'467 IF (check) WRITE(ipslout,*) 'flinopen 3.0 we are realy talking' 468 468 !- 469 469 IF (do_test) THEN … … 474 474 !--- 475 475 IF (check) & 476 WRITE( *,*) 'from file lon first and last, modulo 360. ', &476 WRITE(ipslout,*) 'from file lon first and last, modulo 360. ', & 477 477 x_first, x_last, MODULO(x_first,360.), MODULO(x_last,360.) 478 478 IF (check) & 479 WRITE( *,*) 'from model lon first and last, modulo 360. ', &479 WRITE(ipslout,*) 'from model lon first and last, modulo 360. ', & 480 480 lon(1,1),lon(iilen,jjlen), & 481 481 MODULO(lon(1,1),360.), MODULO(lon(iilen,jjlen),360.) … … 494 494 iret = NF90_GET_VAR (fid, vid, x_last, start=(/ iilast, jjlast /)) 495 495 !--- 496 IF (check) WRITE( *,*) &496 IF (check) WRITE(ipslout,*) & 497 497 'from file lat first and last ',x_first,x_last 498 IF (check) WRITE( *,*) &498 IF (check) WRITE(ipslout,*) & 499 499 'from model lat first and last ',lat(1,1),lat(iilen,jjlen) 500 500 !--- … … 512 512 iret = NF90_GET_VAR (fid, vid, x_last, start=(/ llm /)) 513 513 !----- 514 IF (check) WRITE( *,*) &514 IF (check) WRITE(ipslout,*) & 515 515 'from file lev first and last ',x_first ,x_last 516 IF (check) WRITE( *,*) &516 IF (check) WRITE(ipslout,*) & 517 517 'from model lev first and last ',lev(1),lev(llm) 518 518 !----- … … 530 530 !-- 4.0 extracting the coordinates if we do not check 531 531 !--- 532 IF (check) WRITE( *,*) 'flinopen 4.0 extracting the coordinates'532 IF (check) WRITE(ipslout,*) 'flinopen 4.0 extracting the coordinates' 533 533 !--- 534 534 CALL flinfindcood (fid_out, 'lon', vid, nbdim) … … 575 575 ! 5.0 Get all the details for the time if possible needed 576 576 !- 577 IF (check) WRITE( *,*) 'flinopen 5.0 Get time'577 IF (check) WRITE(ipslout,*) 'flinopen 5.0 Get time' 578 578 !- 579 579 IF (ttm > 0) THEN … … 609 609 DEALLOCATE(vec_tmp) 610 610 !--- 611 IF (check) WRITE( *,*) 'flinopen 5.1 Times ',itaus611 IF (check) WRITE(ipslout,*) 'flinopen 5.1 Times ',itaus 612 612 !--- 613 613 !-- Getting all the details for the time axis … … 630 630 CALL ymds2ju (year0, month0, day0, sec0, date0) 631 631 IF (check) & 632 WRITE( *,*) 'flinopen 5.1 gdtt_id year0 ... date0 ', &632 WRITE(ipslout,*) 'flinopen 5.1 gdtt_id year0 ... date0 ', & 633 633 year0, month0, day0, sec0, date0 634 634 !----- … … 643 643 !----- 644 644 IF (check) & 645 WRITE( *,*) 'flinopen 5.1 gdtmaf_id year0 ... date0 ', &645 WRITE(ipslout,*) 'flinopen 5.1 gdtmaf_id year0 ... date0 ', & 646 646 year0, month0, day0, sec0, date0 647 647 ELSE IF (old_id > 0) THEN … … 660 660 ENDIF 661 661 !- 662 IF (check) WRITE( *,*) 'flinopen 6.0 File opened', date0, dt662 IF (check) WRITE(ipslout,*) 'flinopen 6.0 File opened', date0, dt 663 663 !--------------------------- 664 664 END SUBROUTINE flinopen_work … … 716 716 axname = ADJUSTL(axname) 717 717 !--- 718 IF (check) WRITE( *,*) &718 IF (check) WRITE(ipslout,*) & 719 719 'flininfo - getting axname',iv,axname,lll 720 720 !--- … … 780 780 LOGICAL :: check = .FALSE. 781 781 !--------------------------------------------------------------------- 782 IF (check) WRITE( *,*) &782 IF (check) WRITE(ipslout,*) & 783 783 "flinput_r1d : SIZE(var) = ",SIZE(var) 784 784 !- … … 807 807 LOGICAL :: check = .FALSE. 808 808 !--------------------------------------------------------------------- 809 IF (check) WRITE( *,*) &809 IF (check) WRITE(ipslout,*) & 810 810 "flinput_r2d : SIZE(var) = ",SIZE(var) 811 811 !- … … 834 834 LOGICAL :: check = .FALSE. 835 835 !--------------------------------------------------------------------- 836 IF (check) WRITE( *,*) &836 IF (check) WRITE(ipslout,*) & 837 837 "flinput_r3d : SIZE(var) = ",SIZE(var) 838 838 !- … … 861 861 LOGICAL :: check = .FALSE. 862 862 !--------------------------------------------------------------------- 863 IF (check) WRITE( *,*) &863 IF (check) WRITE(ipslout,*) & 864 864 "flinput_r4d : SIZE(var) = ",SIZE(var) 865 865 !- … … 961 961 !--------------------------------------------------------------------- 962 962 IF (.NOT.ALLOCATED(buff_tmp)) THEN 963 IF (check) WRITE( *,*) &963 IF (check) WRITE(ipslout,*) & 964 964 "flinget_r1d : allocate buff_tmp for buff_sz = ",SIZE(var) 965 965 ALLOCATE (buff_tmp(SIZE(var))) 966 966 ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN 967 IF (check) WRITE( *,*) &967 IF (check) WRITE(ipslout,*) & 968 968 "flinget_r1d : re-allocate buff_tmp for buff_sz = ",SIZE(var) 969 969 DEALLOCATE (buff_tmp) … … 999 999 !--------------------------------------------------------------------- 1000 1000 IF (.NOT.ALLOCATED(buff_tmp)) THEN 1001 IF (check) WRITE( *,*) &1001 IF (check) WRITE(ipslout,*) & 1002 1002 "flinget_r2d : allocate buff_tmp for buff_sz = ",SIZE(var) 1003 1003 ALLOCATE (buff_tmp(SIZE(var))) 1004 1004 ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN 1005 IF (check) WRITE( *,*) &1005 IF (check) WRITE(ipslout,*) & 1006 1006 "flinget_r2d : re-allocate buff_tmp for buff_sz = ",SIZE(var) 1007 1007 DEALLOCATE (buff_tmp) … … 1040 1040 !--------------------------------------------------------------------- 1041 1041 IF (.NOT.ALLOCATED(buff_tmp)) THEN 1042 IF (check) WRITE( *,*) &1042 IF (check) WRITE(ipslout,*) & 1043 1043 "flinget_r2d_zoom : allocate buff_tmp for buff_sz = ",SIZE(var) 1044 1044 ALLOCATE (buff_tmp(SIZE(var))) 1045 1045 ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN 1046 IF (check) WRITE( *,*) &1046 IF (check) WRITE(ipslout,*) & 1047 1047 "flinget_r2d_zoom : re-allocate buff_tmp for buff_sz = ",SIZE(var) 1048 1048 DEALLOCATE (buff_tmp) … … 1080 1080 !--------------------------------------------------------------------- 1081 1081 IF (.NOT.ALLOCATED(buff_tmp)) THEN 1082 IF (check) WRITE( *,*) &1082 IF (check) WRITE(ipslout,*) & 1083 1083 "flinget_r3d : allocate buff_tmp for buff_sz = ",SIZE(var) 1084 1084 ALLOCATE (buff_tmp(SIZE(var))) 1085 1085 ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN 1086 IF (check) WRITE( *,*) &1086 IF (check) WRITE(ipslout,*) & 1087 1087 "flinget_r3d : re-allocate buff_tmp for buff_sz = ",SIZE(var) 1088 1088 DEALLOCATE (buff_tmp) … … 1123 1123 !--------------------------------------------------------------------- 1124 1124 IF (.NOT.ALLOCATED(buff_tmp)) THEN 1125 IF (check) WRITE( *,*) &1125 IF (check) WRITE(ipslout,*) & 1126 1126 "flinget_r3d_zoom : allocate buff_tmp for buff_sz = ",SIZE(var) 1127 1127 ALLOCATE (buff_tmp(SIZE(var))) 1128 1128 ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN 1129 IF (check) WRITE( *,*) &1129 IF (check) WRITE(ipslout,*) & 1130 1130 "flinget_r3d_zoom : re-allocate buff_tmp for buff_sz = ",SIZE(var) 1131 1131 DEALLOCATE (buff_tmp) … … 1165 1165 !--------------------------------------------------------------------- 1166 1166 IF (.NOT.ALLOCATED(buff_tmp)) THEN 1167 IF (check) WRITE( *,*) &1167 IF (check) WRITE(ipslout,*) & 1168 1168 "flinget_r4d : allocate buff_tmp for buff_sz = ",SIZE(var) 1169 1169 ALLOCATE (buff_tmp(SIZE(var))) 1170 1170 ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN 1171 IF (check) WRITE( *,*) &1171 IF (check) WRITE(ipslout,*) & 1172 1172 "flinget_r4d : re-allocate buff_tmp for buff_sz = ",SIZE(var) 1173 1173 DEALLOCATE (buff_tmp) … … 1210 1210 !--------------------------------------------------------------------- 1211 1211 IF (.NOT.ALLOCATED(buff_tmp)) THEN 1212 IF (check) WRITE( *,*) &1212 IF (check) WRITE(ipslout,*) & 1213 1213 "flinget_r4d_zoom : allocate buff_tmp for buff_sz = ",SIZE(var) 1214 1214 ALLOCATE (buff_tmp(SIZE(var))) 1215 1215 ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN 1216 IF (check) WRITE( *,*) &1216 IF (check) WRITE(ipslout,*) & 1217 1217 "flinget_r4d_zoom : re-allocate buff_tmp for buff_sz = ",SIZE(var) 1218 1218 DEALLOCATE (buff_tmp) … … 1309 1309 !- 1310 1310 IF (check) THEN 1311 WRITE( *,*) &1311 WRITE(ipslout,*) & 1312 1312 'flinget_mat : fid_in, fid, varname :', fid_in, fid, TRIM(varname) 1313 WRITE( *,*) &1313 WRITE(ipslout,*) & 1314 1314 'flinget_mat : iim, jjm, llm, ttm, itau_dep, itau_fin :', & 1315 1315 iim, jjm, llm, ttm, itau_dep, itau_fin 1316 WRITE( *,*) &1316 WRITE(ipslout,*) & 1317 1317 'flinget_mat : iideb, iilen, jjdeb, jjlen :', & 1318 1318 iideb, iilen, jjdeb, jjlen … … 1336 1336 ndims=ndims, dimids=dimids, nAtts=nb_atts) 1337 1337 IF (check) THEN 1338 WRITE( *,*) &1338 WRITE(ipslout,*) & 1339 1339 'flinget_mat : fid, vid :', fid, vid 1340 WRITE( *,*) &1340 WRITE(ipslout,*) & 1341 1341 'flinget_mat : ndims, dimids(1:ndims), nb_atts :', & 1342 1342 ndims, dimids(1:ndims), nb_atts … … 1347 1347 iret = NF90_INQUIRE_DIMENSION (fid, dimids(i), len=w_dim(i)) 1348 1348 ENDDO 1349 IF (check) WRITE( *,*) &1349 IF (check) WRITE(ipslout,*) & 1350 1350 'flinget_mat : w_dim :', w_dim(1:ndims) 1351 1351 !- … … 1354 1354 IF (nb_atts > 0) THEN 1355 1355 IF (check) THEN 1356 WRITE( *,*) 'flinget_mat : attributes for variable :'1356 WRITE(ipslout,*) 'flinget_mat : attributes for variable :' 1357 1357 ENDIF 1358 1358 ENDIF … … 1365 1365 iret = NF90_GET_ATT (fid, vid, att_n, tmp_i) 1366 1366 IF (check) THEN 1367 WRITE( *,*) ' ',TRIM(att_n),' : ',tmp_i1367 WRITE(ipslout,*) ' ',TRIM(att_n),' : ',tmp_i 1368 1368 ENDIF 1369 1369 ELSE IF ( (x_typ == NF90_FLOAT).OR.(x_typ == NF90_DOUBLE) ) THEN 1370 1370 iret = NF90_GET_ATT (fid, vid, att_n, tmp_r) 1371 1371 IF (check) THEN 1372 WRITE( *,*) ' ',TRIM(att_n),' : ',tmp_r1372 WRITE(ipslout,*) ' ',TRIM(att_n),' : ',tmp_r 1373 1373 ENDIF 1374 1374 IF (index(att_n,'missing_value') > 0) THEN … … 1379 1379 iret = NF90_GET_ATT (fid, vid, att_n, tmp_n) 1380 1380 IF (check) THEN 1381 WRITE( *,*) ' ',TRIM(att_n),' : ',TRIM(tmp_n)1381 WRITE(ipslout,*) ' ',TRIM(att_n),' : ',TRIM(tmp_n) 1382 1382 ENDIF 1383 1383 IF (index(att_n,'axis') > 0) THEN … … 1402 1402 iret = NF90_INQ_VARID (fid, tmp_n, cvid) 1403 1403 !--- 1404 IF (check) WRITE( *,*) &1404 IF (check) WRITE(ipslout,*) & 1405 1405 'Dimname, iret , NF90_NOERR : ',TRIM(tmp_n),iret,NF90_NOERR 1406 1406 !--- … … 1559 1559 ! 3.0 Reading the data 1560 1560 !- 1561 IF (check) WRITE( *,*) &1561 IF (check) WRITE(ipslout,*) & 1562 1562 'flinget_mat 3.0 : ', uncompress, w_sta, w_len 1563 1563 !--- … … 1584 1584 ENDIF 1585 1585 !- 1586 IF (check) WRITE( *,*) 'flinget_mat 3.1 : ',NF90_STRERROR (iret)1586 IF (check) WRITE(ipslout,*) 'flinget_mat 3.1 : ',NF90_STRERROR (iret) 1587 1587 !-------------------------- 1588 1588 END SUBROUTINE flinget_mat
Note: See TracChangeset
for help on using the changeset viewer.
