Changeset 240 for IOIPSL/trunk
- Timestamp:
- 01/29/08 16:09:09 (16 years ago)
- File:
-
- 1 edited
-
IOIPSL/trunk/src/histcom.f90 (modified) (24 diffs)
Legend:
- Unmodified
- Added
- Removed
-
IOIPSL/trunk/src/histcom.f90
r122 r240 87 87 INTEGER,DIMENSION(nb_files_max),SAVE :: nb_var=0, nb_tax=0 88 88 !- 89 ! DOMAIN IDs for files 90 !- 91 INTEGER,DIMENSION(nb_files_max),SAVE :: dom_id_svg=-1 92 !- 89 93 ! NETCDF IDs for files and axes 90 94 !- 91 95 INTEGER,DIMENSION(nb_files_max),SAVE :: ncdf_ids,xid,yid,tid 92 CHARACTER(LEN=500),SAVE :: assc_file=''93 96 !- 94 97 ! General definitions in the NETCDF file … … 174 177 !--------------------------------------------------------------------- 175 178 !- This is just an interface for histbeg_regular in case when 176 !- the user provides plon and plat as vectors. Obviously this can only177 !- be used for very regular grids.179 !- the user provides plon and plat as vectors. 180 !- Obviously this can only be used for very regular grids. 178 181 !- 179 182 !- INPUT … … 321 324 !- 322 325 INTEGER :: ncid, iret 323 INTEGER :: lengf, lenga324 326 CHARACTER(LEN=120) :: file 325 327 CHARACTER(LEN=30) :: timenow … … 372 374 CALL flio_dom_file (file,domain_id) 373 375 !- 374 ! Keep track of the name of the files opened 375 !- 376 lengf=LEN_TRIM(file) 377 lenga=LEN_TRIM(assc_file) 378 IF (nb_files == 1) THEN 379 assc_file=file(1:lengf) 380 ELSE IF ( (lenga+lengf) < 500) THEN 381 assc_file = assc_file(1:lenga)//' '//file(1:lengf) 382 ELSE IF ( ((lenga+7) < 500) & 383 & .AND.(INDEX(assc_file(1:lenga),'et.al.') < 1) ) THEN 384 assc_file = assc_file(1:lenga)//' et.al.' 376 iret = NF90_CREATE (file, NF90_CLOBBER, ncid) 377 !- 378 IF (rectilinear) THEN 379 iret = NF90_DEF_DIM (ncid,'lon',par_szx,xid(nb_files)) 380 iret = NF90_DEF_DIM (ncid,'lat',par_szy,yid(nb_files)) 385 381 ELSE 386 CALL ipslerr (2,"histbeg", & 387 & 'The file names do not fit into the associate_file attribute.', & 388 & 'Use shorter names if you wish to keep the information.',' ') 389 ENDIF 390 !- 391 iret = NF90_CREATE (file, NF90_CLOBBER, ncid) 392 !- 393 IF (rectilinear) THEN 394 iret = NF90_DEF_DIM (ncid, 'lon', par_szx, xid(nb_files)) 395 iret = NF90_DEF_DIM (ncid, 'lat', par_szy, yid(nb_files)) 396 ELSE 397 iret = NF90_DEF_DIM (ncid, 'x', par_szx, xid(nb_files)) 398 iret = NF90_DEF_DIM (ncid, 'y', par_szy, yid(nb_files)) 382 iret = NF90_DEF_DIM (ncid,'x',par_szx,xid(nb_files)) 383 iret = NF90_DEF_DIM (ncid,'y',par_szy,yid(nb_files)) 399 384 ENDIF 400 385 !- … … 405 390 ! 4.3 Global attributes 406 391 !- 407 iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'Conventions',' GDT 1.3')392 iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'Conventions','CF-1.1') 408 393 iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'file_name',TRIM(file)) 409 394 iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'production',TRIM(model_name)) … … 412 397 iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'TimeStamp',TRIM(timenow)) 413 398 !- 414 ! Add DOMAIN attributes if needed415 !-416 CALL flio_dom_att (ncid,domain_id)417 !-418 399 ! 5.0 Saving some important information on this file in the common 419 400 !- 420 401 IF (check) WRITE(*,*) "histbeg_regular 5.0" 421 402 !- 403 IF (PRESENT(domain_id)) THEN 404 dom_id_svg(pfileid) = domain_id 405 ENDIF 422 406 ncdf_ids(pfileid) = ncid 423 407 full_size(pfileid,1:2) = (/ pim, pjm /) … … 489 473 !- 490 474 INTEGER :: ncid, iret 491 INTEGER :: lengf, lenga492 475 CHARACTER(LEN=120) :: file 493 476 CHARACTER(LEN=30) :: timenow … … 533 516 CALL flio_dom_file (file,domain_id) 534 517 !- 535 ! Keep track of the name of the files opened 536 !- 537 lengf=LEN_TRIM(file) 538 lenga=LEN_TRIM(assc_file) 539 IF (nb_files == 1) THEN 540 assc_file=file(1:lengf) 541 ELSE IF ( (lenga+lengf) < 500) THEN 542 assc_file = assc_file(1:lenga)//' '//file(1:lengf) 543 ELSE IF ( ((lenga+7) < 500) & 544 & .AND.(INDEX(assc_file(1:lenga),'et.al.') < 1) ) THEN 545 assc_file = assc_file(1:lenga)//' et.al.' 546 ELSE 547 CALL ipslerr (2,"histbeg", & 548 & 'The file names do not fit into the associate_file attribute.', & 549 & 'Use shorter names if you wish to keep the information.',' ') 550 ENDIF 551 !- 552 iret = NF90_CREATE (file, NF90_CLOBBER, ncid) 553 !- 554 iret = NF90_DEF_DIM (ncid, 'x', pim, xid(nb_files)) 518 iret = NF90_CREATE (file,NF90_CLOBBER,ncid) 519 !- 520 iret = NF90_DEF_DIM (ncid,'x',pim,xid(nb_files)) 555 521 yid(nb_files) = 0 556 522 !- … … 561 527 ! 4.3 Global attributes 562 528 !- 563 iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'Conventions',' GDT 1.3')529 iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'Conventions','CF-1.1') 564 530 iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'file_name',TRIM(file)) 565 531 iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'production',TRIM(model_name)) … … 568 534 iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'TimeStamp',TRIM(timenow)) 569 535 !- 570 ! Add DOMAIN attributes if needed571 !-572 CALL flio_dom_att (ncid,domain_id)573 !-574 536 ! 5.0 Saving some important information on this file in the common 575 537 !- 576 538 IF (check) WRITE(*,*) "histbeg_irregular 5.0" 577 539 !- 540 IF (PRESENT(domain_id)) THEN 541 dom_id_svg(pfileid) = domain_id 542 ENDIF 578 543 ncdf_ids(pfileid) = ncid 579 544 full_size(pfileid,1:2) = (/ pim, 1 /) … … 701 666 ENDIF 702 667 iret = NF90_DEF_VAR (ncid,lon_name,NF90_FLOAT,dims(1:ndim),nlonid) 668 iret = NF90_PUT_ATT (ncid,nlonid,'axis',"X") 703 669 iret = NF90_PUT_ATT (ncid,nlonid,'units',"degrees_east") 704 670 iret = NF90_PUT_ATT (ncid,nlonid,'valid_min', & … … 718 684 ENDIF 719 685 iret = NF90_DEF_VAR (ncid,lat_name,NF90_FLOAT,dims(1:ndim),nlatid) 686 iret = NF90_PUT_ATT (ncid,nlatid,'axis',"Y") 720 687 iret = NF90_PUT_ATT (ncid,nlatid,'units',"degrees_north") 721 688 iret = NF90_PUT_ATT (ncid,nlatid,'valid_min', & … … 871 838 !- 872 839 iret = NF90_DEF_VAR (ncid,lon_name,NF90_FLOAT,dims(1:ndim),nlonid) 840 iret = NF90_PUT_ATT (ncid,nlonid,'axis',"X") 873 841 iret = NF90_PUT_ATT (ncid,nlonid,'units',"degrees_east") 874 842 iret = NF90_PUT_ATT (ncid,nlonid,'valid_min', & … … 892 860 !- 893 861 iret = NF90_DEF_VAR (ncid,lat_name,NF90_FLOAT,dims(1:ndim),nlatid) 862 iret = NF90_PUT_ATT (ncid,nlatid,'axis',"Y") 894 863 iret = NF90_PUT_ATT (ncid,nlatid,'units',"degrees_north") 895 864 iret = NF90_PUT_ATT (ncid,nlatid,'valid_min', & … … 1054 1023 & zaxid_tmp,zdimid) 1055 1024 !- 1025 iret = NF90_PUT_ATT (ncid,zdimid,'axis',"Z") 1056 1026 leng = MIN(LEN_TRIM(pzaxunit),20) 1057 iret = NF90_PUT_ATT (ncid, zdimid, 'units', pzaxunit(1:leng)) 1058 iret = NF90_PUT_ATT (ncid, zdimid, 'positive', TRIM(direction)) 1059 !- 1027 iret = NF90_PUT_ATT (ncid,zdimid,'units',pzaxunit(1:leng)) 1028 iret = NF90_PUT_ATT (ncid,zdimid,'positive',TRIM(direction)) 1060 1029 iret = NF90_PUT_ATT (ncid,zdimid,'valid_min', & 1061 1030 & REAL(MINVAL(pzvalues(1:pzsize)),KIND=4)) 1062 1031 iret = NF90_PUT_ATT (ncid,zdimid,'valid_max', & 1063 1032 & REAL(MAXVAL(pzvalues(1:pzsize)),KIND=4)) 1064 !-1065 1033 leng = MIN(LEN_TRIM(pzaxname),20) 1066 iret = NF90_PUT_ATT (ncid, zdimid, 'title',pzaxname(1:leng))1034 iret = NF90_PUT_ATT (ncid,zdimid,'title',pzaxname(1:leng)) 1067 1035 leng = MIN(LEN_TRIM(pzaxtitle),80) 1068 iret = NF90_PUT_ATT (ncid, zdimid, 'long_name',pzaxtitle(1:leng))1036 iret = NF90_PUT_ATT (ncid,zdimid,'long_name',pzaxtitle(1:leng)) 1069 1037 !- 1070 1038 iret = NF90_ENDDEF (ncid) 1071 1039 !- 1072 iret = NF90_PUT_VAR (ncid, zdimid,pzvalues(1:pzsize))1040 iret = NF90_PUT_VAR (ncid,zdimid,pzvalues(1:pzsize)) 1073 1041 !- 1074 1042 iret = NF90_REDEF (ncid) … … 1554 1522 iret = NF90_DEF_VAR (ncid,str30,NF90_FLOAT, & 1555 1523 & dims(1),tdimid(pfileid,itx)) 1524 iret = NF90_PUT_ATT (ncid,tdimid(pfileid,itx),'axis',"T") 1556 1525 !--- 1557 1526 ! To transform the current itau into a real date and take it … … 1576 1545 sec = sec-(hours*60.*60.+minutes*60.) 1577 1546 !- 1578 WRITE(str70,7000) year, month, day, hours, minutes, INT(sec) 1547 WRITE (UNIT=str70, & 1548 & FMT='(A,I4.4,"-",I2.2,"-",I2.2," ",I2.2,":",I2.2,":",I2.2)') & 1549 & 'seconds since ',year,month,day,hours,minutes,INT(sec) 1579 1550 iret = NF90_PUT_ATT (ncid,tdimid(pfileid,itx),'units',TRIM(str70)) 1580 1551 !- … … 1588 1559 & 'long_name','Time axis') 1589 1560 !- 1590 WRITE(str70,7001) year, cal(month), day, hours, minutes, INT(sec) 1561 WRITE (UNIT=str70, & 1562 & FMT='(" ",I4.4,"-",A3,"-",I2.2," ",I2.2,":",I2.2,":",I2.2)') & 1563 & year,cal(month),day,hours,minutes,INT(sec) 1591 1564 iret = NF90_PUT_ATT (ncid,tdimid(pfileid,itx), & 1592 1565 & 'time_origin',TRIM(str70)) 1593 1566 ENDDO 1594 !-1595 ! The formats we need1596 !-1597 7000 FORMAT('seconds since ', I4.4,'-',I2.2,'-',I2.2,' ',I2.2,':',I2.2,':',I2.2)1598 7001 FORMAT(' ', I4.4,'-',A3,'-',I2.2,' ',I2.2,':',I2.2,':',I2.2)1599 1567 !- 1600 1568 ! 2.0 declare the variables … … 1668 1636 !- 1669 1637 SELECT CASE(ndim) 1670 CASE(-3) 1671 str30 = 'ZYX' 1672 CASE(2) 1673 str30 = 'YX' 1674 CASE(3) 1675 str30 = 'TYX' 1676 CASE(4) 1677 str30 = 'TZYX' 1638 CASE(-3,2:4) 1678 1639 CASE DEFAULT 1679 1640 CALL ipslerr (3,"histend", & … … 1681 1642 & 'allowed at this stage',' ') 1682 1643 END SELECT 1683 !-1684 iret = NF90_PUT_ATT (ncid,ncvarid,'axis',TRIM(str30))1685 1644 !- 1686 1645 assoc='nav_lat nav_lon' … … 1712 1671 ENDIF 1713 1672 ENDDO 1673 !- 1674 ! 2.2 Add DOMAIN attributes if needed 1675 !- 1676 IF (dom_id_svg(pfileid) >= 0) THEN 1677 CALL flio_dom_att (ncid,dom_id_svg(pfileid)) 1678 ENDIF 1714 1679 !- 1715 1680 ! 3.0 Put the netcdf file into wrte mode … … 2636 2601 INTEGER,INTENT(in),OPTIONAL :: fid 2637 2602 !- 2638 INTEGER :: ifile,ncid,iret,iv ,ncvarid2603 INTEGER :: ifile,ncid,iret,iv 2639 2604 INTEGER :: start_loop,end_loop 2640 2605 CHARACTER(LEN=70) :: str70 … … 2656 2621 ncid = ncdf_ids(ifile) 2657 2622 iret = NF90_REDEF (ncid) 2658 !- 2659 !-- 1. The loop on the number of variables to add 2660 !- some final information 2661 !- 2623 !--- 2624 !-- 1. Loop on the number of variables to add some final information 2625 !--- 2662 2626 IF ( check ) WRITE(*,*) 'Entering loop on vars :', nb_var(ifile) 2663 DO iv =1,nb_var(ifile)2627 DO iv=1,nb_var(ifile) 2664 2628 IF (hist_wrt_rng(ifile,iv)) THEN 2665 2629 IF (check) THEN … … 2670 2634 ENDIF 2671 2635 IF (hist_calc_rng(ifile,iv)) THEN 2672 !-------- 1.1 Put the min and max values on the file 2673 ncvarid = ncvar_ids(ifile,iv) 2674 iret = NF90_PUT_ATT (ncid,ncvarid,'valid_min', & 2636 !-------- Put the min and max values on the file 2637 iret = NF90_PUT_ATT (ncid,ncvar_ids(ifile,iv),'valid_min', & 2675 2638 & REAL(hist_minmax(ifile,iv,1),KIND=4)) 2676 iret = NF90_PUT_ATT (ncid,ncvar id,'valid_max', &2639 iret = NF90_PUT_ATT (ncid,ncvar_ids(ifile,iv),'valid_max', & 2677 2640 & REAL(hist_minmax(ifile,iv,2),KIND=4)) 2678 2641 ENDIF 2679 2642 ENDIF 2680 2643 ENDDO 2681 !- 2682 !-- 2.0 We list the names of the other files 2683 !-- in the associated_file attribute 2684 !- 2685 IF (nb_files > 1 ) THEN 2686 iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'associate_file', & 2687 & TRIM(assc_file)) 2688 ENDIF 2689 IF ( check ) WRITE(*,*) 'close file :', ncid 2644 !--- 2645 !-- 2.0 Close the file 2646 !--- 2647 IF (check) WRITE(*,*) 'close file :', ncid 2690 2648 iret = NF90_CLOSE (ncid) 2691 2649 IF (iret /= NF90_NOERR) THEN
Note: See TracChangeset
for help on using the changeset viewer.
