- Timestamp:
- 2016-01-08T10:35:19+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r4691 r6225 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 … … 33 32 USE icb_oce, ONLY : nclasses, class_num ! !: iceberg classes 34 33 #if defined key_lim3 35 USE par_ice34 USE ice , ONLY : jpl 36 35 #elif defined key_lim2 37 36 USE par_ice_2 … … 61 60 #if defined key_iomput 62 61 PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_get_file_attr, iom_set_grid_attr 63 PRIVATE set_grid, set_ scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate62 PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate 64 63 # endif 65 64 … … 98 97 CHARACTER(len=10) :: clname 99 98 INTEGER :: ji 100 !!---------------------------------------------------------------------- 99 ! 100 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_bnds 101 !!---------------------------------------------------------------------- 102 103 ALLOCATE( z_bnds(jpk,2) ) 101 104 102 105 clname = cdname 103 106 IF( TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(cdname) 104 # if defined key_mpp_mpi105 107 CALL xios_context_initialize(TRIM(clname), mpi_comm_opa) 106 # else107 CALL xios_context_initialize(TRIM(clname), 0)108 # endif109 108 CALL iom_swap( cdname ) 110 109 … … 121 120 CALL set_scalar 122 121 123 IF( TRIM(cdname) == "nemo") THEN122 IF( TRIM(cdname) == TRIM(cxios_context) ) THEN 124 123 CALL set_grid( "T", glamt, gphit ) 125 124 CALL set_grid( "U", glamu, gphiu ) 126 125 CALL set_grid( "V", glamv, gphiv ) 127 126 CALL set_grid( "W", glamt, gphit ) 128 ENDIF 129 130 IF( TRIM(cdname) == "nemo_crs" ) THEN 127 CALL set_grid_znl( gphit ) 128 ! 129 IF( ln_cfmeta ) THEN ! Add additional grid metadata 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)) 134 CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit ) 135 CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu ) 136 CALL set_grid_bounds( "V", glamu, gphiu, glamv, gphiv ) 137 CALL set_grid_bounds( "W", glamf, gphif, glamt, gphit ) 138 ENDIF 139 ENDIF 140 141 IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN 131 142 CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain 132 143 ! … … 135 146 CALL set_grid( "V", glamv_crs, gphiv_crs ) 136 147 CALL set_grid( "W", glamt_crs, gphit_crs ) 148 CALL set_grid_znl( gphit_crs ) 137 149 ! 138 150 CALL dom_grid_glo ! Return to parent grid domain 139 ENDIF 140 151 ! 152 IF( ln_cfmeta ) THEN ! Add additional grid metadata 153 CALL iom_set_domain_attr("grid_T", area = e1e2t_crs(nldi:nlei, nldj:nlej)) 154 CALL iom_set_domain_attr("grid_U", area = e1u_crs(nldi:nlei, nldj:nlej) * e2u_crs(nldi:nlei, nldj:nlej)) 155 CALL iom_set_domain_attr("grid_V", area = e1v_crs(nldi:nlei, nldj:nlej) * e2v_crs(nldi:nlei, nldj:nlej)) 156 CALL iom_set_domain_attr("grid_W", area = e1e2t_crs(nldi:nlei, nldj:nlej)) 157 CALL set_grid_bounds( "T", glamf_crs, gphif_crs, glamt_crs, gphit_crs ) 158 CALL set_grid_bounds( "U", glamv_crs, gphiv_crs, glamu_crs, gphiu_crs ) 159 CALL set_grid_bounds( "V", glamu_crs, gphiu_crs, glamv_crs, gphiv_crs ) 160 CALL set_grid_bounds( "W", glamf_crs, gphif_crs, glamt_crs, gphit_crs ) 161 ENDIF 162 ENDIF 141 163 142 164 ! vertical grid definition … … 145 167 CALL iom_set_axis_attr( "depthv", gdept_1d ) 146 168 CALL iom_set_axis_attr( "depthw", gdepw_1d ) 169 170 ! Add vertical grid bounds 171 z_bnds(: ,1) = gdepw_1d(:) 172 z_bnds(1:jpkm1,2) = gdepw_1d(2:jpk) 173 z_bnds(jpk: ,2) = gdepw_1d(jpk) + e3t_1d(jpk) 174 CALL iom_set_axis_attr( "deptht", bounds=z_bnds ) 175 CALL iom_set_axis_attr( "depthu", bounds=z_bnds ) 176 CALL iom_set_axis_attr( "depthv", bounds=z_bnds ) 177 z_bnds(: ,2) = gdept_1d(:) 178 z_bnds(2:jpk,1) = gdept_1d(1:jpkm1) 179 z_bnds(1 ,1) = gdept_1d(1) - e3w_1d(1) 180 CALL iom_set_axis_attr( "depthw", bounds=z_bnds ) 181 147 182 # if defined key_floats 148 183 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) ) … … 152 187 #endif 153 188 CALL iom_set_axis_attr( "icbcla", class_num ) 189 CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) ) 190 CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) ) 154 191 155 192 ! automatic definitions of some of the xml attributs … … 162 199 163 200 CALL xios_update_calendar(0) 201 202 DEALLOCATE( z_bnds ) 203 164 204 #endif 165 205 … … 205 245 CHARACTER(LEN=256) :: clname ! the name of the file based on cdname [[+clcpu]+clcpu] 206 246 CHARACTER(LEN=256) :: cltmpn ! tempory name to store clname (in writting mode) 207 CHARACTER(LEN=10) :: clsuffix ! ".nc" or ".dimg"247 CHARACTER(LEN=10) :: clsuffix ! ".nc" 208 248 CHARACTER(LEN=15) :: clcpu ! the cpu number (max jpmax_digits digits) 209 249 CHARACTER(LEN=256) :: clinfo ! info character … … 268 308 ! which suffix should we use? 269 309 SELECT CASE (iolib) 270 CASE (jpioipsl ) ; clsuffix = '.nc'271 310 CASE (jpnf90 ) ; clsuffix = '.nc' 272 CASE (jprstdimg) ; clsuffix = '.dimg'273 311 CASE DEFAULT ; clsuffix = '' 274 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) ' ) 275 313 END SELECT 276 314 ! Add the suffix if needed … … 285 323 IF( .NOT.llok ) THEN 286 324 ! we try to add the cpu number to the name 287 IF( iolib == jprstdimg ) THEN ; WRITE(clcpu,*) narea 288 ELSE ; WRITE(clcpu,*) narea-1 289 ENDIF 325 WRITE(clcpu,*) narea-1 326 290 327 clcpu = TRIM(ADJUSTL(clcpu)) 291 328 iln = INDEX(clname,TRIM(clsuffix), back = .TRUE.) … … 334 371 END SELECT 335 372 ENDIF 336 ! Open the NetCDF or RSTDIMGfile373 ! Open the NetCDF file 337 374 ! ============= 338 375 ! do we have some free file identifier? … … 358 395 IF( istop == nstop ) THEN ! no error within this routine 359 396 SELECT CASE (iolib) 360 CASE (jpioipsl ) ; CALL iom_ioipsl_open( clname, kiomid, llwrt, llok, idompar )361 397 CASE (jpnf90 ) ; CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar ) 362 CASE (jprstdimg) ; CALL iom_rstdimg_open( clname, kiomid, llwrt, llok, idompar )363 398 CASE DEFAULT 364 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) ' ) 365 400 END SELECT 366 401 ENDIF … … 397 432 IF( iom_file(jf)%nfid > 0 ) THEN 398 433 SELECT CASE (iom_file(jf)%iolib) 399 CASE (jpioipsl ) ; CALL iom_ioipsl_close( jf )400 434 CASE (jpnf90 ) ; CALL iom_nf90_close( jf ) 401 CASE (jprstdimg) ; CALL iom_rstdimg_close( jf )402 435 CASE DEFAULT 403 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)' ) 404 437 END SELECT 405 438 iom_file(jf)%nfid = 0 ! free the id … … 456 489 IF( iiv <= jpmax_vars ) THEN 457 490 SELECT CASE (iom_file(kiomid)%iolib) 458 CASE (jpioipsl ) ; iom_varid = iom_ioipsl_varid( kiomid, cdvar, iiv, kdimsz )459 491 CASE (jpnf90 ) ; iom_varid = iom_nf90_varid ( kiomid, cdvar, iiv, kdimsz, kndims ) 460 CASE (jprstdimg) ; iom_varid = -1 ! all variables are listed in iom_file 461 CASE DEFAULT 462 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)' ) 463 494 END SELECT 464 495 ELSE … … 518 549 & 'Use ncwa -a to suppress the unnecessary dimensions' ) 519 550 SELECT CASE (iom_file(kiomid)%iolib) 520 CASE (jpioipsl ) ; CALL iom_ioipsl_get( kiomid, idvar, pvar, itime )521 551 CASE (jpnf90 ) ; CALL iom_nf90_get( kiomid, idvar, pvar, itime ) 522 CASE (jprstdimg) ; CALL iom_rstdimg_get( kiomid, idvar, pvar ) 523 CASE DEFAULT 524 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)' ) 525 554 END SELECT 526 555 ENDIF … … 543 572 END SUBROUTINE iom_g1d 544 573 545 SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )574 SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr ) 546 575 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 547 576 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 551 580 INTEGER , INTENT(in ), DIMENSION(2) , OPTIONAL :: kstart ! start axis position of the reading 552 581 INTEGER , INTENT(in ), DIMENSION(2) , OPTIONAL :: kcount ! number of points in each axis 582 LOGICAL , INTENT(in ) , OPTIONAL :: lrowattr ! logical flag telling iom_get to 583 ! look for and use a file attribute 584 ! called open_ocean_jstart to set the start 585 ! value for the 2nd dimension (netcdf only) 553 586 ! 554 587 IF( kiomid > 0 ) THEN 555 588 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r2d=pvar, & 556 & ktime=ktime, kstart=kstart, kcount=kcount ) 589 & ktime=ktime, kstart=kstart, kcount=kcount, & 590 & lrowattr=lrowattr ) 557 591 ENDIF 558 592 END SUBROUTINE iom_g2d 559 593 560 SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )594 SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr ) 561 595 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 562 596 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 566 600 INTEGER , INTENT(in ), DIMENSION(3) , OPTIONAL :: kstart ! start axis position of the reading 567 601 INTEGER , INTENT(in ), DIMENSION(3) , OPTIONAL :: kcount ! number of points in each axis 602 LOGICAL , INTENT(in ) , OPTIONAL :: lrowattr ! logical flag telling iom_get to 603 ! look for and use a file attribute 604 ! called open_ocean_jstart to set the start 605 ! value for the 2nd dimension (netcdf only) 568 606 ! 569 607 IF( kiomid > 0 ) THEN 570 608 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r3d=pvar, & 571 & ktime=ktime, kstart=kstart, kcount=kcount ) 609 & ktime=ktime, kstart=kstart, kcount=kcount, & 610 & lrowattr=lrowattr ) 572 611 ENDIF 573 612 END SUBROUTINE iom_g3d … … 576 615 SUBROUTINE iom_get_123d( kiomid, kdom , cdvar , & 577 616 & pv_r1d, pv_r2d, pv_r3d, & 578 & ktime , kstart, kcount ) 617 & ktime , kstart, kcount, & 618 & lrowattr ) 579 619 !!----------------------------------------------------------------------- 580 620 !! *** ROUTINE iom_get_123d *** … … 593 633 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kstart ! start position of the reading in each axis 594 634 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kcount ! number of points to be read in each axis 635 LOGICAL , INTENT(in ), OPTIONAL :: lrowattr ! logical flag telling iom_get to 636 ! look for and use a file attribute 637 ! called open_ocean_jstart to set the start 638 ! value for the 2nd dimension (netcdf only) 595 639 ! 596 640 LOGICAL :: llnoov ! local definition to read overlap 641 LOGICAL :: luse_jattr ! local definition to read open_ocean_jstart file attribute 642 INTEGER :: jstartrow ! start point for 2nd dimension optionally set by file attribute 597 643 INTEGER :: jl ! loop on number of dimension 598 644 INTEGER :: idom ! type of domain … … 604 650 INTEGER :: ix1, ix2, iy1, iy2 ! subdomain indexes 605 651 INTEGER :: ji, jj ! loop counters 606 INTEGER :: irankpv 652 INTEGER :: irankpv ! 607 653 INTEGER :: ind1, ind2 ! substring index 608 654 INTEGER, DIMENSION(jpmax_dims) :: istart ! starting point to read for each axis … … 615 661 CHARACTER(LEN=256) :: clname ! file name 616 662 CHARACTER(LEN=1) :: clrankpv, cldmspc ! 663 LOGICAL :: ll_depth_spec ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension. 617 664 !--------------------------------------------------------------------- 618 665 ! … … 627 674 IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') 628 675 IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 629 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') 678 679 luse_jattr = .false. 680 IF( PRESENT(lrowattr) ) THEN 681 IF( lrowattr .AND. idom /= jpdom_data ) CALL ctl_stop(trim(clinfo), 'lrowattr present and true needs kdom = jpdom_data') 682 IF( lrowattr .AND. idom == jpdom_data ) luse_jattr = .true. 683 ENDIF 684 IF( luse_jattr ) THEN 685 SELECT CASE (iom_file(kiomid)%iolib) 686 CASE (jpnf90 ) 687 ! Ok 688 CASE DEFAULT 689 CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 690 END SELECT 691 ENDIF 630 692 631 693 ! Search for the variable in the data base (eventually actualize data) … … 643 705 ! update idom definition... 644 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 645 713 IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN 646 714 IF( idom == jpdom_autoglo ) THEN ; idom = jpdom_global … … 696 764 istart(idmspc+1) = itime 697 765 698 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) 699 767 ELSE 700 IF( idom == jpdom_unknown ) THEN ; icnt(1:idmspc) = idimsz(1:idmspc)768 IF( idom == jpdom_unknown ) THEN ; icnt(1:idmspc) = idimsz(1:idmspc) 701 769 ELSE 702 770 IF( .NOT. PRESENT(pv_r1d) ) THEN ! not a 1D array 703 IF( idom == jpdom_data ) THEN ; istart(1:2) = (/ mig(1), mjg(1) /) ! icnt(1:2) done bellow 704 ELSEIF( idom == jpdom_global ) THEN ; istart(1:2) = (/ nimpp , njmpp /) ! icnt(1:2) done bellow 771 IF( idom == jpdom_data ) THEN 772 jstartrow = 1 773 IF( luse_jattr ) THEN 774 CALL iom_getatt(kiomid, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found 775 jstartrow = MAX(1,jstartrow) 776 ENDIF 777 istart(1:2) = (/ mig(1), mjg(1) + jstartrow - 1 /) ! icnt(1:2) done below 778 ELSEIF( idom == jpdom_global ) THEN ; istart(1:2) = (/ nimpp , njmpp /) ! icnt(1:2) done below 705 779 ENDIF 706 780 ! we do not read the overlap -> we start to read at nldi, nldj … … 715 789 ENDIF 716 790 IF( PRESENT(pv_r3d) ) THEN 717 IF( idom == jpdom_data ) THEN ; icnt(3) = jpkdta 718 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 719 794 ENDIF 720 795 ENDIF … … 785 860 786 861 SELECT CASE (iom_file(kiomid)%iolib) 787 CASE (jpioipsl ) ; CALL iom_ioipsl_get( kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, &788 & pv_r1d, pv_r2d, pv_r3d )789 862 CASE (jpnf90 ) ; CALL iom_nf90_get( kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, & 790 863 & pv_r1d, pv_r2d, pv_r3d ) 791 CASE (jprstdimg) ; CALL iom_rstdimg_get( kiomid, idom, idvar, ix1, ix2, iy1, iy2, & 792 & pv_r1d, pv_r2d, pv_r3d ) 793 CASE DEFAULT 794 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)' ) 795 866 END SELECT 796 867 … … 822 893 IF( zofs /= 0. ) pv_r1d(:) = pv_r1d(:) + zofs 823 894 ELSEIF( PRESENT(pv_r2d) ) THEN 824 !CDIR COLLAPSE825 895 IF( zscf /= 1.) pv_r2d(:,:) = pv_r2d(:,:) * zscf 826 !CDIR COLLAPSE827 896 IF( zofs /= 0.) pv_r2d(:,:) = pv_r2d(:,:) + zofs 828 897 ELSEIF( PRESENT(pv_r3d) ) THEN 829 !CDIR COLLAPSE830 898 IF( zscf /= 1.) pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf 831 !CDIR COLLAPSE832 899 IF( zofs /= 0.) pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs 833 900 ENDIF … … 879 946 IF( iom_file(kiomid)%dimsz(1,idvar) <= size(ptime) ) THEN 880 947 SELECT CASE (iom_file(kiomid)%iolib) 881 CASE (jpioipsl ) ; CALL iom_ioipsl_gettime( kiomid, idvar, ptime, cdunits, cdcalendar )882 948 CASE (jpnf90 ) ; CALL iom_nf90_gettime( kiomid, idvar, ptime, cdunits, cdcalendar ) 883 CASE (jprstdimg) ; CALL ctl_stop( TRIM(clinfo)//' case IO library == jprstdimg not coded...' ) 884 CASE DEFAULT 885 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)' ) 886 951 END SELECT 887 952 ELSE … … 914 979 IF( iom_file(kiomid)%nfid > 0 ) THEN 915 980 SELECT CASE (iom_file(kiomid)%iolib) 916 CASE (jpioipsl ) ; CALL ctl_stop('iom_getatt: only nf90 available')917 981 CASE (jpnf90 ) ; CALL iom_nf90_getatt( kiomid, cdatt, pvar ) 918 CASE (jprstdimg) ; CALL ctl_stop('iom_getatt: only nf90 available') 919 CASE DEFAULT 920 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' ) 921 984 END SELECT 922 985 ENDIF … … 940 1003 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 941 1004 SELECT CASE (iom_file(kiomid)%iolib) 942 CASE (jpioipsl ) ; CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar )943 1005 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar ) 944 CASE (jprstdimg) ; IF( kt == kwrite ) CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pvar ) 945 CASE DEFAULT 946 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)' ) 947 1008 END SELECT 948 1009 ENDIF … … 962 1023 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 963 1024 SELECT CASE (iom_file(kiomid)%iolib) 964 CASE (jpioipsl ) ; CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar )965 1025 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar ) 966 CASE (jprstdimg) ; IF( kt == kwrite ) CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r1d = pvar ) 967 CASE DEFAULT 968 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)' ) 969 1028 END SELECT 970 1029 ENDIF … … 984 1043 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 985 1044 SELECT CASE (iom_file(kiomid)%iolib) 986 CASE (jpioipsl ) ; CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar )987 1045 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar ) 988 CASE (jprstdimg) ; IF( kt == kwrite ) CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r2d = pvar ) 989 CASE DEFAULT 990 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)' ) 991 1048 END SELECT 992 1049 ENDIF … … 1006 1063 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1007 1064 SELECT CASE (iom_file(kiomid)%iolib) 1008 CASE (jpioipsl ) ; CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar )1009 1065 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar ) 1010 CASE (jprstdimg) ; IF( kt == kwrite ) CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r3d = pvar ) 1011 CASE DEFAULT 1012 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)' ) 1013 1068 END SELECT 1014 1069 ENDIF … … 1067 1122 1068 1123 SUBROUTINE iom_set_domain_attr( cdid, ni_glo, nj_glo, ibegin, jbegin, ni, nj, zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, & 1069 & data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask ) 1070 CHARACTER(LEN=*) , INTENT(in) :: cdid 1071 INTEGER , OPTIONAL, INTENT(in) :: ni_glo, nj_glo, ibegin, jbegin, ni, nj 1072 INTEGER , OPTIONAL, INTENT(in) :: data_dim, data_ibegin, data_ni, data_jbegin, data_nj 1073 INTEGER , OPTIONAL, INTENT(in) :: zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj 1074 REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: lonvalue, latvalue 1075 LOGICAL, DIMENSION(:,:), OPTIONAL, INTENT(in) :: mask 1124 & data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask, & 1125 & nvertex, bounds_lon, bounds_lat, area ) 1126 CHARACTER(LEN=*) , INTENT(in) :: cdid 1127 INTEGER , OPTIONAL, INTENT(in) :: ni_glo, nj_glo, ibegin, jbegin, ni, nj 1128 INTEGER , OPTIONAL, INTENT(in) :: data_dim, data_ibegin, data_ni, data_jbegin, data_nj 1129 INTEGER , OPTIONAL, INTENT(in) :: zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, nvertex 1130 REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: lonvalue, latvalue 1131 REAL(wp), DIMENSION(:,:) , OPTIONAL, INTENT(in) :: bounds_lon, bounds_lat, area 1132 LOGICAL, DIMENSION(:,:) , OPTIONAL, INTENT(in) :: mask 1076 1133 1077 1134 IF ( xios_is_valid_domain (cdid) ) THEN … … 1079 1136 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , & 1080 1137 & zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj, & 1081 & lonvalue=lonvalue, latvalue=latvalue,mask=mask ) 1138 & lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon, & 1139 & bounds_lat=bounds_lat, area=area ) 1082 1140 ENDIF 1083 1141 … … 1086 1144 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , & 1087 1145 & zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj, & 1088 & lonvalue=lonvalue, latvalue=latvalue,mask=mask ) 1146 & lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon, & 1147 & bounds_lat=bounds_lat, area=area ) 1089 1148 ENDIF 1090 1149 CALL xios_solve_inheritance() … … 1093 1152 1094 1153 1095 SUBROUTINE iom_set_axis_attr( cdid, paxis )1154 SUBROUTINE iom_set_axis_attr( cdid, paxis, bounds ) 1096 1155 CHARACTER(LEN=*) , INTENT(in) :: cdid 1097 REAL(wp), DIMENSION(:), INTENT(in) :: paxis 1098 IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, size=size(paxis),value=paxis ) 1099 IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, size=size(paxis),value=paxis ) 1156 REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: paxis 1157 REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) :: bounds 1158 IF ( PRESENT(paxis) ) THEN 1159 IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, size=SIZE(paxis), value=paxis ) 1160 IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, size=SIZE(paxis), value=paxis ) 1161 ENDIF 1162 IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, bounds=bounds ) 1163 IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, bounds=bounds ) 1100 1164 CALL xios_solve_inheritance() 1101 1165 END SUBROUTINE iom_set_axis_attr … … 1106 1170 CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: freq_op 1107 1171 CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: freq_offset 1108 IF ( xios_is_valid_field (cdid) ) CALL xios_set_field_attr ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1109 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 ) 1110 1176 CALL xios_solve_inheritance() 1111 1177 END SUBROUTINE iom_set_field_attr … … 1160 1226 CALL iom_swap( cdname ) ! swap to cdname context 1161 1227 CALL xios_update_calendar(kt) 1162 IF( cdname /= "nemo" ) CALL iom_swap( "nemo") ! return back to nemo context1228 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) ) ! return back to nemo context 1163 1229 ! 1164 1230 END SUBROUTINE iom_setkt … … 1166 1232 SUBROUTINE iom_context_finalize( cdname ) 1167 1233 CHARACTER(LEN=*), INTENT(in) :: cdname 1168 ! 1169 CALL iom_swap( cdname ) ! swap to cdname context 1170 CALL xios_context_finalize() ! finalize the context 1171 IF( cdname /= "nemo" ) CALL iom_swap( "nemo" ) ! return back to nemo context 1234 ! 1235 IF( xios_is_valid_context(cdname) ) THEN 1236 CALL iom_swap( cdname ) ! swap to cdname context 1237 CALL xios_context_finalize() ! finalize the context 1238 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) ) ! return back to nemo context 1239 ENDIF 1172 1240 ! 1173 1241 END SUBROUTINE iom_context_finalize … … 1200 1268 CASE('T') ; zmask(:,:,:) = tmask(:,:,:) 1201 1269 CASE('U') ; zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:) ; CALL lbc_lnk( zmask, 'U', 1. ) 1202 CASE('V') ; zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jp i,:) ; CALL lbc_lnk( zmask, 'V', 1. )1270 CASE('V') ; zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:) ; CALL lbc_lnk( zmask, 'V', 1. ) 1203 1271 CASE('W') ; zmask(:,:,2:jpk ) = tmask(:,:,1:jpkm1) + tmask(:,:,2:jpk) ; zmask(:,:,1) = tmask(:,:,1) 1204 1272 END SELECT … … 1211 1279 1212 1280 1281 SUBROUTINE set_grid_bounds( cdgrd, plon_cnr, plat_cnr, plon_pnt, plat_pnt ) 1282 !!---------------------------------------------------------------------- 1283 !! *** ROUTINE set_grid_bounds *** 1284 !! 1285 !! ** Purpose : define horizontal grid corners 1286 !! 1287 !!---------------------------------------------------------------------- 1288 CHARACTER(LEN=1) , INTENT(in) :: cdgrd 1289 ! 1290 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plon_cnr, plat_cnr ! Lat/lon coordinates of a contiguous vertex of cell (i,j) 1291 REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt ! Lat/lon coordinates of the point of cell (i,j) 1292 ! 1293 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z_bnds ! Lat/lon coordinates of the vertices of cell (i,j) 1294 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_fld ! Working array to determine where to rotate cells 1295 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_rot ! Lat/lon working array for rotation of cells 1296 ! 1297 INTEGER :: icnr, jcnr ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 1298 ! ! represents the bottom-left corner of cell (i,j) 1299 INTEGER :: ji, jj, jn, ni, nj 1300 1301 ALLOCATE( z_bnds(4,jpi,jpj,2), z_fld(jpi,jpj), z_rot(4,2) ) 1302 1303 ! Offset of coordinate representing bottom-left corner 1304 SELECT CASE ( TRIM(cdgrd) ) 1305 CASE ('T', 'W') 1306 icnr = -1 ; jcnr = -1 1307 CASE ('U') 1308 icnr = 0 ; jcnr = -1 1309 CASE ('V') 1310 icnr = -1 ; jcnr = 0 1311 END SELECT 1312 1313 ni = nlei-nldi+1 ; nj = nlej-nldj+1 ! Dimensions of subdomain interior 1314 1315 z_fld(:,:) = 1._wp 1316 CALL lbc_lnk( z_fld, cdgrd, -1. ) ! Working array for location of northfold 1317 1318 ! Cell vertices that can be defined 1319 DO jj = 2, jpjm1 1320 DO ji = 2, jpim1 1321 z_bnds(1,ji,jj,1) = plat_cnr(ji+icnr, jj+jcnr ) ! Bottom-left 1322 z_bnds(2,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr ) ! Bottom-right 1323 z_bnds(3,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 1324 z_bnds(4,ji,jj,1) = plat_cnr(ji+icnr, jj+jcnr+1) ! Top-left 1325 z_bnds(1,ji,jj,2) = plon_cnr(ji+icnr, jj+jcnr ) ! Bottom-left 1326 z_bnds(2,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr ) ! Bottom-right 1327 z_bnds(3,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 1328 z_bnds(4,ji,jj,2) = plon_cnr(ji+icnr, jj+jcnr+1) ! Top-left 1329 END DO 1330 END DO 1331 1332 ! Cell vertices on boundries 1333 DO jn = 1, 4 1334 CALL lbc_lnk( z_bnds(jn,:,:,1), cdgrd, 1., pval=999._wp ) 1335 CALL lbc_lnk( z_bnds(jn,:,:,2), cdgrd, 1., pval=999._wp ) 1336 END DO 1337 1338 ! Zero-size cells at closed boundaries if cell points provided, 1339 ! otherwise they are closed cells with unrealistic bounds 1340 IF( PRESENT(plon_pnt) .AND. PRESENT(plat_pnt) ) THEN 1341 IF( (nbondi == -1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN 1342 DO jn = 1, 4 ! (West or jpni = 1), closed E-W 1343 z_bnds(jn,1,:,1) = plat_pnt(1,:) ; z_bnds(jn,1,:,2) = plon_pnt(1,:) 1344 END DO 1345 ENDIF 1346 IF( (nbondi == 1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN 1347 DO jn = 1, 4 ! (East or jpni = 1), closed E-W 1348 z_bnds(jn,nlci,:,1) = plat_pnt(nlci,:) ; z_bnds(jn,nlci,:,2) = plon_pnt(nlci,:) 1349 END DO 1350 ENDIF 1351 IF( nbondj == -1 .OR. (nbondj == 2 .AND. jperio /= 2) ) THEN 1352 DO jn = 1, 4 ! South or (jpnj = 1, not symmetric) 1353 z_bnds(jn,:,1,1) = plat_pnt(:,1) ; z_bnds(jn,:,1,2) = plon_pnt(:,1) 1354 END DO 1355 ENDIF 1356 IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio < 3 ) THEN 1357 DO jn = 1, 4 ! (North or jpnj = 1), no north fold 1358 z_bnds(jn,:,nlcj,1) = plat_pnt(:,nlcj) ; z_bnds(jn,:,nlcj,2) = plon_pnt(:,nlcj) 1359 END DO 1360 ENDIF 1361 ENDIF 1362 1363 ! Rotate cells at the north fold 1364 IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio >= 3 ) THEN 1365 DO jj = 1, jpj 1366 DO ji = 1, jpi 1367 IF( z_fld(ji,jj) == -1. ) THEN 1368 z_rot(1,:) = z_bnds(3,ji,jj,:) ; z_rot(2,:) = z_bnds(4,ji,jj,:) 1369 z_rot(3,:) = z_bnds(1,ji,jj,:) ; z_rot(4,:) = z_bnds(2,ji,jj,:) 1370 z_bnds(:,ji,jj,:) = z_rot(:,:) 1371 ENDIF 1372 END DO 1373 END DO 1374 1375 ! Invert cells at the symmetric equator 1376 ELSE IF( nbondj == 2 .AND. jperio == 2 ) THEN 1377 DO ji = 1, jpi 1378 z_rot(1:2,:) = z_bnds(3:4,ji,1,:) 1379 z_rot(3:4,:) = z_bnds(1:2,ji,1,:) 1380 z_bnds(:,ji,1,:) = z_rot(:,:) 1381 END DO 1382 ENDIF 1383 1384 CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,1),(/ 4,ni*nj /)), & 1385 bounds_lon = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,2),(/ 4,ni*nj /)), nvertex=4 ) 1386 1387 DEALLOCATE( z_bnds, z_fld, z_rot ) 1388 1389 END SUBROUTINE set_grid_bounds 1390 1391 1392 SUBROUTINE set_grid_znl( plat ) 1393 !!---------------------------------------------------------------------- 1394 !! *** ROUTINE set_grid_znl *** 1395 !! 1396 !! ** Purpose : define grids for zonal mean 1397 !! 1398 !!---------------------------------------------------------------------- 1399 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plat 1400 ! 1401 REAL(wp), DIMENSION(:), ALLOCATABLE :: zlon 1402 INTEGER :: ni,nj, ix, iy 1403 1404 1405 ni=nlei-nldi+1 ; nj=nlej-nldj+1 ! define zonal mean domain (jpj*jpk) 1406 ALLOCATE( zlon(ni*nj) ) ; zlon(:) = 0. 1407 1408 CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj) 1409 CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 1410 CALL iom_set_domain_attr("gznl", lonvalue = zlon, & 1411 & latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /))) 1412 ! 1413 CALL dom_ngb( 180., 90., ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots) 1414 CALL iom_set_domain_attr ('ptr', zoom_ibegin=ix, zoom_nj=jpjglo) 1415 CALL iom_update_file_name('ptr') 1416 ! 1417 END SUBROUTINE set_grid_znl 1418 1213 1419 SUBROUTINE set_scalar 1214 1420 !!---------------------------------------------------------------------- … … 1218 1424 !! 1219 1425 !!---------------------------------------------------------------------- 1220 REAL(wp), DIMENSION(1) :: zz = 1.1426 REAL(wp), DIMENSION(1) :: zz = 1. 1221 1427 !!---------------------------------------------------------------------- 1222 1428 CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea, jbegin=1, ni=1, nj=1) 1223 1429 CALL iom_set_domain_attr('scalarpoint', data_dim=2, data_ibegin = 1, data_ni = 1, data_jbegin = 1, data_nj = 1) 1430 1224 1431 zz=REAL(narea,wp) 1225 1432 CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz) … … 1238 1445 CHARACTER(len=256) :: clsuff ! suffix name 1239 1446 CHARACTER(len=1) :: cl1 ! 1 character 1240 CHARACTER(len=2) :: cl2 ! 1 character 1447 CHARACTER(len=2) :: cl2 ! 2 characters 1448 CHARACTER(len=3) :: cl3 ! 3 characters 1241 1449 INTEGER :: ji, jg ! loop counters 1242 1450 INTEGER :: ix, iy ! i-,j- index … … 1264 1472 WRITE(cl2,'(i2.2)') ji 1265 1473 CALL iom_update_file_name('file'//cl2) 1474 END DO 1475 DO ji = 1, 999 1476 WRITE(cl3,'(i3.3)') ji 1477 CALL iom_update_file_name('file'//cl3) 1266 1478 END DO 1267 1479 … … 1289 1501 zlatpira = (/ -19.0, -14.0, -8.0, 0.0, 4.0, 8.0, 12.0, 15.0, 20.0 /) 1290 1502 CALL set_mooring( zlonpira, zlatpira ) 1503 1291 1504 1292 1505 END SUBROUTINE set_xmlatt … … 1410 1623 idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 1411 1624 DO WHILE ( idx /= 0 ) 1412 cldate = iom_sdate( fjulday - rdt tra(1)/ rday )1625 cldate = iom_sdate( fjulday - rdt / rday ) 1413 1626 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+11:LEN_TRIM(clname)) 1414 1627 idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') … … 1417 1630 idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@') 1418 1631 DO WHILE ( idx /= 0 ) 1419 cldate = iom_sdate( fjulday - rdt tra(1)/ rday, ldfull = .TRUE. )1632 cldate = iom_sdate( fjulday - rdt / rday, ldfull = .TRUE. ) 1420 1633 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+15:LEN_TRIM(clname)) 1421 1634 idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@') … … 1424 1637 idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') 1425 1638 DO WHILE ( idx /= 0 ) 1426 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. ) 1427 1640 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+9:LEN_TRIM(clname)) 1428 1641 idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') … … 1431 1644 idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') 1432 1645 DO WHILE ( idx /= 0 ) 1433 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. ) 1434 1647 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+13:LEN_TRIM(clname)) 1435 1648 idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') 1436 1649 END DO 1437 1650 1651 IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 1438 1652 IF( jn == 1 ) CALL iom_set_file_attr( cdid, name = clname ) 1439 1653 IF( jn == 2 ) CALL iom_set_file_attr( cdid, name_suffix = clname ) … … 1483 1697 ENDIF 1484 1698 1699 !$AGRIF_DO_NOT_TREAT 1700 ! Should be fixed in the conv 1485 1701 IF( llfull ) THEN 1486 1702 clfmt = TRIM(clfmt)//",'_',i2.2,':',i2.2,':',i2.2" … … 1493 1709 WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday ! date of the end of run 1494 1710 ENDIF 1711 !$AGRIF_END_DO_NOT_TREAT 1495 1712 1496 1713 END FUNCTION iom_sdate
Note: See TracChangeset
for help on using the changeset viewer.
