- Timestamp:
- 2016-07-19T10:38:35+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r5426 r6808 8 8 !! 3.0 ! 2007-07 (D. Storkey) Changes to iom_gettime 9 9 !! 3.4 ! 2012-12 (R. Bourdalle-Badie and G. Reffray) add C1D case 10 !! 3.6 ! 2014-15 DIMG format removed 10 11 !!-------------------------------------------------------------------- 11 12 … … 23 24 USE lbclnk ! lateal boundary condition / mpp exchanges 24 25 USE iom_def ! iom variables definitions 25 USE iom_ioipsl ! NetCDF format with IOIPSL library26 26 USE iom_nf90 ! NetCDF format with native NetCDF library 27 USE iom_rstdimg ! restarts access direct format "dimg" style...28 27 USE in_out_manager ! I/O manager 29 28 USE lib_mpp ! MPP library … … 129 128 ! 130 129 IF( ln_cfmeta ) THEN ! Add additional grid metadata 131 CALL iom_set_domain_attr("grid_T", area = e1 2t(nldi:nlei, nldj:nlej))132 CALL iom_set_domain_attr("grid_U", area = e1 2u(nldi:nlei, nldj:nlej))133 CALL iom_set_domain_attr("grid_V", area = e1 2v(nldi:nlei, nldj:nlej))134 CALL iom_set_domain_attr("grid_W", area = e1 2t(nldi:nlei, nldj:nlej))130 CALL iom_set_domain_attr("grid_T", area = e1e2t(nldi:nlei, nldj:nlej)) 131 CALL iom_set_domain_attr("grid_U", area = e1e2u(nldi:nlei, nldj:nlej)) 132 CALL iom_set_domain_attr("grid_V", area = e1e2v(nldi:nlei, nldj:nlej)) 133 CALL iom_set_domain_attr("grid_W", area = e1e2t(nldi:nlei, nldj:nlej)) 135 134 CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit ) 136 135 CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu ) … … 246 245 CHARACTER(LEN=256) :: clname ! the name of the file based on cdname [[+clcpu]+clcpu] 247 246 CHARACTER(LEN=256) :: cltmpn ! tempory name to store clname (in writting mode) 248 CHARACTER(LEN=10) :: clsuffix ! ".nc" or ".dimg"247 CHARACTER(LEN=10) :: clsuffix ! ".nc" 249 248 CHARACTER(LEN=15) :: clcpu ! the cpu number (max jpmax_digits digits) 250 249 CHARACTER(LEN=256) :: clinfo ! info character … … 309 308 ! which suffix should we use? 310 309 SELECT CASE (iolib) 311 CASE (jpioipsl ) ; clsuffix = '.nc'312 310 CASE (jpnf90 ) ; clsuffix = '.nc' 313 CASE (jprstdimg) ; clsuffix = '.dimg'314 311 CASE DEFAULT ; clsuffix = '' 315 CALL ctl_stop( TRIM(clinfo), 'accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )312 CALL ctl_stop( TRIM(clinfo), 'accepted IO library is only jpnf90 (jpioipsl option has been removed) ' ) 316 313 END SELECT 317 314 ! Add the suffix if needed … … 326 323 IF( .NOT.llok ) THEN 327 324 ! we try to add the cpu number to the name 328 IF( iolib == jprstdimg ) THEN ; WRITE(clcpu,*) narea 329 ELSE ; WRITE(clcpu,*) narea-1 330 ENDIF 325 WRITE(clcpu,*) narea-1 326 331 327 clcpu = TRIM(ADJUSTL(clcpu)) 332 328 iln = INDEX(clname,TRIM(clsuffix), back = .TRUE.) … … 375 371 END SELECT 376 372 ENDIF 377 ! Open the NetCDF or RSTDIMGfile373 ! Open the NetCDF file 378 374 ! ============= 379 375 ! do we have some free file identifier? … … 399 395 IF( istop == nstop ) THEN ! no error within this routine 400 396 SELECT CASE (iolib) 401 CASE (jpioipsl ) ; CALL iom_ioipsl_open( clname, kiomid, llwrt, llok, idompar )402 397 CASE (jpnf90 ) ; CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar ) 403 CASE (jprstdimg) ; CALL iom_rstdimg_open( clname, kiomid, llwrt, llok, idompar )404 398 CASE DEFAULT 405 CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )399 CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed) ' ) 406 400 END SELECT 407 401 ENDIF … … 438 432 IF( iom_file(jf)%nfid > 0 ) THEN 439 433 SELECT CASE (iom_file(jf)%iolib) 440 CASE (jpioipsl ) ; CALL iom_ioipsl_close( jf )441 434 CASE (jpnf90 ) ; CALL iom_nf90_close( jf ) 442 CASE (jprstdimg) ; CALL iom_rstdimg_close( jf )443 435 CASE DEFAULT 444 CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )436 CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 445 437 END SELECT 446 438 iom_file(jf)%nfid = 0 ! free the id … … 497 489 IF( iiv <= jpmax_vars ) THEN 498 490 SELECT CASE (iom_file(kiomid)%iolib) 499 CASE (jpioipsl ) ; iom_varid = iom_ioipsl_varid( kiomid, cdvar, iiv, kdimsz )500 491 CASE (jpnf90 ) ; iom_varid = iom_nf90_varid ( kiomid, cdvar, iiv, kdimsz, kndims ) 501 CASE (jprstdimg) ; iom_varid = -1 ! all variables are listed in iom_file 502 CASE DEFAULT 503 CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 492 CASE DEFAULT 493 CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 504 494 END SELECT 505 495 ELSE … … 559 549 & 'Use ncwa -a to suppress the unnecessary dimensions' ) 560 550 SELECT CASE (iom_file(kiomid)%iolib) 561 CASE (jpioipsl ) ; CALL iom_ioipsl_get( kiomid, idvar, pvar, itime )562 551 CASE (jpnf90 ) ; CALL iom_nf90_get( kiomid, idvar, pvar, itime ) 563 CASE (jprstdimg) ; CALL iom_rstdimg_get( kiomid, idvar, pvar ) 564 CASE DEFAULT 565 CALL ctl_stop( 'iom_g0d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 552 CASE DEFAULT 553 CALL ctl_stop( 'iom_g0d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 566 554 END SELECT 567 555 ENDIF … … 673 661 CHARACTER(LEN=256) :: clname ! file name 674 662 CHARACTER(LEN=1) :: clrankpv, cldmspc ! 663 LOGICAL :: ll_depth_spec ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension. 675 664 !--------------------------------------------------------------------- 676 665 ! … … 685 674 IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') 686 675 IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 687 IF( PRESENT(kstart) .AND. idom /= jpdom_unknown ) CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown') 676 IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND. idom /= jpdom_autoglo_xy ) & 677 & CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown or kdom = jpdom_autoglo_xy') 688 678 689 679 luse_jattr = .false. … … 694 684 IF( luse_jattr ) THEN 695 685 SELECT CASE (iom_file(kiomid)%iolib) 696 CASE (jpioipsl, jprstdimg )697 CALL ctl_warn(trim(clinfo), 'lrowattr present and true but this only works with netcdf (jpnf90)')698 luse_jattr = .false.699 686 CASE (jpnf90 ) 700 687 ! Ok 701 688 CASE DEFAULT 702 CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )689 CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 703 690 END SELECT 704 691 ENDIF … … 718 705 ! update idom definition... 719 706 ! Identify the domain in case of jpdom_auto(glo/dta) definition 707 IF( idom == jpdom_autoglo_xy ) THEN 708 ll_depth_spec = .TRUE. 709 idom = jpdom_autoglo 710 ELSE 711 ll_depth_spec = .FALSE. 712 ENDIF 720 713 IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN 721 714 IF( idom == jpdom_autoglo ) THEN ; idom = jpdom_global … … 771 764 istart(idmspc+1) = itime 772 765 773 IF( PRESENT(kstart)) THEN ; istart(1:idmspc) = kstart(1:idmspc) ; icnt(1:idmspc) = kcount(1:idmspc)766 IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN ; istart(1:idmspc) = kstart(1:idmspc) ; icnt(1:idmspc) = kcount(1:idmspc) 774 767 ELSE 775 IF( idom == jpdom_unknown ) THEN ; icnt(1:idmspc) = idimsz(1:idmspc)768 IF( idom == jpdom_unknown ) THEN ; icnt(1:idmspc) = idimsz(1:idmspc) 776 769 ELSE 777 770 IF( .NOT. PRESENT(pv_r1d) ) THEN ! not a 1D array … … 796 789 ENDIF 797 790 IF( PRESENT(pv_r3d) ) THEN 798 IF( idom == jpdom_data ) THEN ; icnt(3) = jpkdta 799 ELSE ; icnt(3) = jpk 791 IF( idom == jpdom_data ) THEN ; icnt(3) = jpkdta 792 ELSE IF( ll_depth_spec .AND. PRESENT(kstart) ) THEN ; istart(3) = kstart(3); icnt(3) = kcount(3) 793 ELSE ; icnt(3) = jpk 800 794 ENDIF 801 795 ENDIF … … 866 860 867 861 SELECT CASE (iom_file(kiomid)%iolib) 868 CASE (jpioipsl ) ; CALL iom_ioipsl_get( kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, &869 & pv_r1d, pv_r2d, pv_r3d )870 862 CASE (jpnf90 ) ; CALL iom_nf90_get( kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, & 871 863 & pv_r1d, pv_r2d, pv_r3d ) 872 CASE (jprstdimg) ; CALL iom_rstdimg_get( kiomid, idom, idvar, ix1, ix2, iy1, iy2, & 873 & pv_r1d, pv_r2d, pv_r3d ) 874 CASE DEFAULT 875 CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 864 CASE DEFAULT 865 CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 876 866 END SELECT 877 867 … … 903 893 IF( zofs /= 0. ) pv_r1d(:) = pv_r1d(:) + zofs 904 894 ELSEIF( PRESENT(pv_r2d) ) THEN 905 !CDIR COLLAPSE906 895 IF( zscf /= 1.) pv_r2d(:,:) = pv_r2d(:,:) * zscf 907 !CDIR COLLAPSE908 896 IF( zofs /= 0.) pv_r2d(:,:) = pv_r2d(:,:) + zofs 909 897 ELSEIF( PRESENT(pv_r3d) ) THEN 910 !CDIR COLLAPSE911 898 IF( zscf /= 1.) pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf 912 !CDIR COLLAPSE913 899 IF( zofs /= 0.) pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs 914 900 ENDIF … … 960 946 IF( iom_file(kiomid)%dimsz(1,idvar) <= size(ptime) ) THEN 961 947 SELECT CASE (iom_file(kiomid)%iolib) 962 CASE (jpioipsl ) ; CALL iom_ioipsl_gettime( kiomid, idvar, ptime, cdunits, cdcalendar )963 948 CASE (jpnf90 ) ; CALL iom_nf90_gettime( kiomid, idvar, ptime, cdunits, cdcalendar ) 964 CASE (jprstdimg) ; CALL ctl_stop( TRIM(clinfo)//' case IO library == jprstdimg not coded...' ) 965 CASE DEFAULT 966 CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 949 CASE DEFAULT 950 CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 967 951 END SELECT 968 952 ELSE … … 995 979 IF( iom_file(kiomid)%nfid > 0 ) THEN 996 980 SELECT CASE (iom_file(kiomid)%iolib) 997 CASE (jpioipsl ) ; CALL ctl_stop('iom_getatt: only nf90 available')998 981 CASE (jpnf90 ) ; CALL iom_nf90_getatt( kiomid, cdatt, pvar ) 999 CASE (jprstdimg) ; CALL ctl_stop('iom_getatt: only nf90 available') 1000 CASE DEFAULT 1001 CALL ctl_stop( 'iom_g0d_att: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 982 CASE DEFAULT 983 CALL ctl_stop( 'iom_g0d_att: accepted IO library is only jpnf90' ) 1002 984 END SELECT 1003 985 ENDIF … … 1021 1003 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1022 1004 SELECT CASE (iom_file(kiomid)%iolib) 1023 CASE (jpioipsl ) ; CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar )1024 1005 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar ) 1025 CASE (jprstdimg) ; IF( kt == kwrite ) CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pvar ) 1026 CASE DEFAULT 1027 CALL ctl_stop( 'iom_rp0d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 1006 CASE DEFAULT 1007 CALL ctl_stop( 'iom_rp0d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1028 1008 END SELECT 1029 1009 ENDIF … … 1043 1023 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1044 1024 SELECT CASE (iom_file(kiomid)%iolib) 1045 CASE (jpioipsl ) ; CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar )1046 1025 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar ) 1047 CASE (jprstdimg) ; IF( kt == kwrite ) CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r1d = pvar ) 1048 CASE DEFAULT 1049 CALL ctl_stop( 'iom_rp1d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 1026 CASE DEFAULT 1027 CALL ctl_stop( 'iom_rp1d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1050 1028 END SELECT 1051 1029 ENDIF … … 1065 1043 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1066 1044 SELECT CASE (iom_file(kiomid)%iolib) 1067 CASE (jpioipsl ) ; CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar )1068 1045 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar ) 1069 CASE (jprstdimg) ; IF( kt == kwrite ) CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r2d = pvar ) 1070 CASE DEFAULT 1071 CALL ctl_stop( 'iom_rp2d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 1046 CASE DEFAULT 1047 CALL ctl_stop( 'iom_rp2d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1072 1048 END SELECT 1073 1049 ENDIF … … 1087 1063 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1088 1064 SELECT CASE (iom_file(kiomid)%iolib) 1089 CASE (jpioipsl ) ; CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar )1090 1065 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar ) 1091 CASE (jprstdimg) ; IF( kt == kwrite ) CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r3d = pvar ) 1092 CASE DEFAULT 1093 CALL ctl_stop( 'iom_rp3d: accepted IO library are only jpioipsl and jprstdimg' ) 1066 CASE DEFAULT 1067 CALL ctl_stop( 'iom_rp3d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1094 1068 END SELECT 1095 1069 ENDIF … … 1196 1170 CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: freq_op 1197 1171 CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: freq_offset 1198 IF ( xios_is_valid_field (cdid) ) CALL xios_set_field_attr ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1199 IF ( xios_is_valid_fieldgroup(cdid) ) CALL xios_set_fieldgroup_attr( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1172 IF ( xios_is_valid_field (cdid) ) CALL xios_set_field_attr & 1173 & ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1174 IF ( xios_is_valid_fieldgroup(cdid) ) CALL xios_set_fieldgroup_attr & 1175 & ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1200 1176 CALL xios_solve_inheritance() 1201 1177 END SUBROUTINE iom_set_field_attr … … 1647 1623 idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 1648 1624 DO WHILE ( idx /= 0 ) 1649 cldate = iom_sdate( fjulday - rdt tra(1)/ rday )1625 cldate = iom_sdate( fjulday - rdt / rday ) 1650 1626 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+11:LEN_TRIM(clname)) 1651 1627 idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') … … 1654 1630 idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@') 1655 1631 DO WHILE ( idx /= 0 ) 1656 cldate = iom_sdate( fjulday - rdt tra(1)/ rday, ldfull = .TRUE. )1632 cldate = iom_sdate( fjulday - rdt / rday, ldfull = .TRUE. ) 1657 1633 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+15:LEN_TRIM(clname)) 1658 1634 idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@') … … 1661 1637 idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') 1662 1638 DO WHILE ( idx /= 0 ) 1663 cldate = iom_sdate( fjulday + rdt tra(1)/ rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. )1639 cldate = iom_sdate( fjulday + rdt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. ) 1664 1640 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+9:LEN_TRIM(clname)) 1665 1641 idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') … … 1668 1644 idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') 1669 1645 DO WHILE ( idx /= 0 ) 1670 cldate = iom_sdate( fjulday + rdt tra(1)/ rday * REAL( nitend - nit000, wp ), ld24 = .TRUE., ldfull = .TRUE. )1646 cldate = iom_sdate( fjulday + rdt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE., ldfull = .TRUE. ) 1671 1647 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+13:LEN_TRIM(clname)) 1672 1648 idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') 1673 1649 END DO 1674 1650 1651 IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 1675 1652 IF( jn == 1 ) CALL iom_set_file_attr( cdid, name = clname ) 1676 1653 IF( jn == 2 ) CALL iom_set_file_attr( cdid, name_suffix = clname ) … … 1720 1697 ENDIF 1721 1698 1699 !$AGRIF_DO_NOT_TREAT 1700 ! Should be fixed in the conv 1722 1701 IF( llfull ) THEN 1723 1702 clfmt = TRIM(clfmt)//",'_',i2.2,':',i2.2,':',i2.2" … … 1730 1709 WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday ! date of the end of run 1731 1710 ENDIF 1711 !$AGRIF_END_DO_NOT_TREAT 1732 1712 1733 1713 END FUNCTION iom_sdate
Note: See TracChangeset
for help on using the changeset viewer.