Changeset 14072 for NEMO/trunk/src/OCE/IOM/iom.F90
- Timestamp:
- 2020-12-04T08:48:38+01:00 (3 years ago)
- File:
-
- 1 edited
-
NEMO/trunk/src/OCE/IOM/iom.F90 (modified) (92 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/IOM/iom.F90
r14068 r14072 7 7 !! 2.0 ! 2006-02 (S. Masson) Adaptation to NEMO 8 8 !! 3.0 ! 2007-07 (D. Storkey) Changes to iom_gettime 9 !! 3.4 ! 2012-12 (R. Bourdalle-Badie and G. Reffray) add C1D case 9 !! 3.4 ! 2012-12 (R. Bourdalle-Badie and G. Reffray) add C1D case 10 10 !! 3.6 ! 2014-15 DIMG format removed 11 11 !! 3.6 ! 2015-15 (J. Harle) Added procedure to read REAL attributes … … 21 21 !!---------------------------------------------------------------------- 22 22 USE dom_oce ! ocean space and time domain 23 USE domutl ! 23 USE domutl ! 24 24 USE c1d ! 1D vertical configuration 25 25 USE flo_oce ! floats module declarations … … 44 44 USE trc, ONLY : profsed 45 45 #endif 46 USE lib_fortran 46 USE lib_fortran 47 47 USE diu_bulk, ONLY : ln_diurnal_only, ln_diurnal 48 48 USE iom_nf90 … … 51 51 IMPLICIT NONE 52 52 PUBLIC ! must be public to be able to access iom_def through iom 53 53 54 54 #if defined key_iomput 55 55 LOGICAL, PUBLIC, PARAMETER :: lk_iomput = .TRUE. !: iom_put flag … … 95 95 MODULE PROCEDURE iom_p0d_dp, iom_p1d_dp, iom_p2d_dp, iom_p3d_dp, iom_p4d_dp 96 96 END INTERFACE iom_put 97 97 98 98 !! * Substitutions 99 99 # include "do_loop_substitute.h90" … … 105 105 CONTAINS 106 106 107 SUBROUTINE iom_init( cdname, kdid, ld_closedef ) 107 SUBROUTINE iom_init( cdname, kdid, ld_closedef ) 108 108 !!---------------------------------------------------------------------- 109 109 !! *** ROUTINE *** 110 110 !! 111 !! ** Purpose : 111 !! ** Purpose : 112 112 !! 113 113 !!---------------------------------------------------------------------- 114 114 CHARACTER(len=*), INTENT(in) :: cdname 115 INTEGER , OPTIONAL, INTENT(in) :: kdid 115 INTEGER , OPTIONAL, INTENT(in) :: kdid 116 116 LOGICAL , OPTIONAL, INTENT(in) :: ld_closedef 117 117 #if defined key_iomput … … 123 123 INTEGER :: ji 124 124 LOGICAL :: llrst_context ! is context related to restart 125 LOGICAL :: llrstr, llrstw 125 LOGICAL :: llrstr, llrstw 126 126 INTEGER :: inum 127 127 ! … … 152 152 llrst_context = llrstr .OR. llrstw 153 153 154 ! Calendar type is now defined in xml file 154 ! Calendar type is now defined in xml file 155 155 IF (.NOT.(xios_getvar('ref_year' ,irefyear ))) irefyear = 1900 156 156 IF (.NOT.(xios_getvar('ref_month',irefmonth))) irefmonth = 01 … … 169 169 IF(.NOT.llrst_context) CALL set_scalar 170 170 ! 171 IF( cdname == cxios_context ) THEN 172 CALL set_grid( "T", glamt, gphit, .FALSE., .FALSE. ) 171 IF( cdname == cxios_context ) THEN 172 CALL set_grid( "T", glamt, gphit, .FALSE., .FALSE. ) 173 173 CALL set_grid( "U", glamu, gphiu, .FALSE., .FALSE. ) 174 174 CALL set_grid( "V", glamv, gphiv, .FALSE., .FALSE. ) … … 191 191 ENDIF 192 192 ! 193 IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN 193 IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN 194 194 CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain 195 195 ! … … 223 223 224 224 ! ABL 225 IF( .NOT. ALLOCATED(ght_abl) ) THEN ! force definition for xml files (xios) 225 IF( .NOT. ALLOCATED(ght_abl) ) THEN ! force definition for xml files (xios) 226 226 ALLOCATE( ght_abl(jpka), ghw_abl(jpka), e3t_abl(jpka), e3w_abl(jpka) ) ! default allocation needed by iom 227 227 ght_abl(:) = -1._wp ; ghw_abl(:) = -1._wp … … 230 230 CALL iom_set_axis_attr( "ght_abl", ght_abl(2:jpka) ) 231 231 CALL iom_set_axis_attr( "ghw_abl", ghw_abl(2:jpka) ) 232 232 233 233 ! Add vertical grid bounds 234 234 zt_bnds(2,: ) = gdept_1d(:) … … 338 338 !! 339 339 !! ** Purpose : define filename in XIOS context for reading file, 340 !! enable variables present in a file for reading with XIOS 340 !! enable variables present in a file for reading with XIOS 341 341 !! id of the file is assumed to be rrestart. 342 342 !!--------------------------------------------------------------------- 343 INTEGER, INTENT(IN) :: idnum 344 343 INTEGER, INTENT(IN) :: idnum 344 345 345 #if defined key_iomput 346 346 INTEGER :: ndims, nvars, natts, unlimitedDimId, dimlen, xtype,mdims … … 423 423 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname, & 424 424 domain_ref="grid_N", prec = 8, & 425 operation = "instant" ) 425 operation = "instant" ) 426 426 ELSEIF(mdims == 1) THEN 427 427 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname, & … … 433 433 operation = "instant" ) 434 434 ELSE 435 WRITE(ctmp1,*) 'iom_set_vars_active: variable ', TRIM(varname) ,' incorrect number of dimensions' 435 WRITE(ctmp1,*) 'iom_set_vars_active: variable ', TRIM(varname) ,' incorrect number of dimensions' 436 436 CALL ctl_stop( 'iom_set_vars_active:', ctmp1 ) 437 437 ENDIF … … 457 457 CALL xios_get_handle("file_definition", filegroup_hdl ) 458 458 CALL xios_add_child(filegroup_hdl, file_hdl, 'wrestart') 459 IF(nxioso.eq.1) THEN 460 CALL xios_set_file_attr( "wrestart", type="one_file", enabled=.TRUE.,& 461 mode="write", output_freq=xios_timestep) 462 IF(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in one_file mode' 463 ELSE 464 CALL xios_set_file_attr( "wrestart", type="multiple_file", enabled=.TRUE.,& 465 mode="write", output_freq=xios_timestep) 466 IF(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in multiple_file mode' 467 ENDIF 459 IF(nxioso.eq.1) THEN 460 CALL xios_set_file_attr( "wrestart", type="one_file", enabled=.TRUE.,& 461 mode="write", output_freq=xios_timestep) 462 IF(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in one_file mode' 463 ELSE 464 CALL xios_set_file_attr( "wrestart", type="multiple_file", enabled=.TRUE.,& 465 mode="write", output_freq=xios_timestep) 466 IF(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in multiple_file mode' 467 ENDIF 468 468 CALL xios_set_file_attr( "wrestart", name=trim(cdrst_file)) 469 469 #endif … … 486 486 REAL(dp), OPTIONAL, INTENT(IN), DIMENSION(:, :) :: rd2 487 487 REAL(sp), OPTIONAL, INTENT(IN), DIMENSION(:, :) :: rs2 488 REAL(dp), OPTIONAL, INTENT(IN), DIMENSION(:, :, :) :: rd3 488 REAL(dp), OPTIONAL, INTENT(IN), DIMENSION(:, :, :) :: rd3 489 489 REAL(sp), OPTIONAL, INTENT(IN), DIMENSION(:, :, :) :: rs3 490 490 #if defined key_iomput … … 509 509 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & 510 510 domain_ref = "grid_N", prec = 8, & 511 operation = "instant" ) 511 operation = "instant" ) 512 512 ELSEIF(PRESENT(rs2)) THEN 513 513 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, & … … 540 540 !! ** Purpose : Used for grid definition when XIOS is used to read/write 541 541 !! restart. Returns axis corresponding to the number of levels 542 !! given as an input variable. Axes are defined in routine 542 !! given as an input variable. Axes are defined in routine 543 543 !! iom_set_rst_context 544 544 !!--------------------------------------------------------------------- … … 551 551 ELSEIF(idlev == jpl) THEN 552 552 axis_ref="numcat" 553 #endif 553 #endif 554 554 ELSE 555 555 write(str, *) idlev … … 562 562 !! *** FUNCTION *** 563 563 !! 564 !! ** Purpose : this function returns first available id to keep information about file 564 !! ** Purpose : this function returns first available id to keep information about file 565 565 !! sets filename in iom_file structure and sets name 566 566 !! of XIOS context depending on cdcomp … … 583 583 END FUNCTION iom_xios_setid 584 584 585 SUBROUTINE iom_set_rst_context(ld_rstr) 585 SUBROUTINE iom_set_rst_context(ld_rstr) 586 586 !!--------------------------------------------------------------------- 587 587 !! *** SUBROUTINE iom_set_rst_context *** 588 588 !! 589 !! ** Purpose : Define domain, axis and grid for restart (read/write) 590 !! context 591 !! 589 !! ** Purpose : Define domain, axis and grid for restart (read/write) 590 !! context 591 !! 592 592 !!--------------------------------------------------------------------- 593 593 LOGICAL, INTENT(IN) :: ld_rstr 594 594 INTEGER :: ji 595 595 #if defined key_iomput 596 TYPE(xios_domaingroup) :: domaingroup_hdl 597 TYPE(xios_domain) :: domain_hdl 598 TYPE(xios_axisgroup) :: axisgroup_hdl 599 TYPE(xios_axis) :: axis_hdl 600 TYPE(xios_scalar) :: scalar_hdl 601 TYPE(xios_scalargroup) :: scalargroup_hdl 602 603 CALL xios_get_handle("domain_definition",domaingroup_hdl) 604 CALL xios_add_child(domaingroup_hdl, domain_hdl, "grid_N") 605 CALL set_grid("N", glamt, gphit, .TRUE., ld_rstr) 606 607 CALL xios_get_handle("axis_definition",axisgroup_hdl) 608 CALL xios_add_child(axisgroup_hdl, axis_hdl, "nav_lev") 596 TYPE(xios_domaingroup) :: domaingroup_hdl 597 TYPE(xios_domain) :: domain_hdl 598 TYPE(xios_axisgroup) :: axisgroup_hdl 599 TYPE(xios_axis) :: axis_hdl 600 TYPE(xios_scalar) :: scalar_hdl 601 TYPE(xios_scalargroup) :: scalargroup_hdl 602 603 CALL xios_get_handle("domain_definition",domaingroup_hdl) 604 CALL xios_add_child(domaingroup_hdl, domain_hdl, "grid_N") 605 CALL set_grid("N", glamt, gphit, .TRUE., ld_rstr) 606 607 CALL xios_get_handle("axis_definition",axisgroup_hdl) 608 CALL xios_add_child(axisgroup_hdl, axis_hdl, "nav_lev") 609 609 !AGRIF fails to compile when unit= is in call to xios_set_axis_attr 610 ! CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels", unit="m", positive="down") 610 ! CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels", unit="m", positive="down") 611 611 CALL xios_set_axis_attr( "nav_lev", long_name = "Vertical levels in meters", positive = "down") 612 CALL iom_set_axis_attr( "nav_lev", paxis = gdept_1d ) 612 CALL iom_set_axis_attr( "nav_lev", paxis = gdept_1d ) 613 613 #if defined key_si3 614 614 CALL xios_add_child(axisgroup_hdl, axis_hdl, "numcat") 615 615 CALL iom_set_axis_attr( "numcat", (/ (REAL(ji,wp), ji=1,jpl) /) ) 616 616 #endif 617 CALL xios_get_handle("scalar_definition", scalargroup_hdl) 618 CALL xios_add_child(scalargroup_hdl, scalar_hdl, "grid_scalar") 617 CALL xios_get_handle("scalar_definition", scalargroup_hdl) 618 CALL xios_add_child(scalargroup_hdl, scalar_hdl, "grid_scalar") 619 619 #endif 620 620 END SUBROUTINE iom_set_rst_context 621 621 622 622 623 SUBROUTINE set_xios_context(kdid, cdcont) 623 SUBROUTINE set_xios_context(kdid, cdcont) 624 624 !!--------------------------------------------------------------------- 625 625 !! *** SUBROUTINE iom_set_rst_context *** 626 626 !! 627 627 !! ** Purpose : set correct XIOS context based on kdid 628 !! 628 !! 629 629 !!--------------------------------------------------------------------- 630 630 INTEGER, INTENT(IN) :: kdid ! Identifier of the file 631 631 CHARACTER(LEN=lc), INTENT(OUT) :: cdcont ! name of the context for XIOS read/write 632 632 633 633 cdcont = "NONE" 634 634 … … 637 637 cdcont = cr_ocerst_cxt 638 638 ELSEIF(kdid == numrir) THEN 639 cdcont = cr_icerst_cxt 639 cdcont = cr_icerst_cxt 640 640 ELSEIF(kdid == numrtr) THEN 641 641 cdcont = cr_toprst_cxt … … 696 696 CHARACTER(LEN=256) :: clname ! the name of the file based on cdname [[+clcpu]+clcpu] 697 697 CHARACTER(LEN=256) :: cltmpn ! tempory name to store clname (in writting mode) 698 CHARACTER(LEN=10) :: clsuffix ! ".nc" 698 CHARACTER(LEN=10) :: clsuffix ! ".nc" 699 699 CHARACTER(LEN=15) :: clcpu ! the cpu number (max jpmax_digits digits) 700 700 CHARACTER(LEN=256) :: clinfo ! info character 701 LOGICAL :: llok ! check the existence 701 LOGICAL :: llok ! check the existence 702 702 LOGICAL :: llwrt ! local definition of ldwrt 703 703 LOGICAL :: llstop ! local definition of ldstop … … 705 705 INTEGER :: icnt ! counter for digits in clcpu (max = jpmax_digits) 706 706 INTEGER :: iln, ils ! lengths of character 707 INTEGER :: istop ! 707 INTEGER :: istop ! 708 708 ! local number of points for x,y dimensions 709 709 ! position of first local point for x,y dimensions … … 741 741 clname = trim(cdname) 742 742 IF ( .NOT. Agrif_Root() .AND. .NOT. lliof ) THEN 743 iln = INDEX(clname,'/') 743 iln = INDEX(clname,'/') 744 744 cltmpn = clname(1:iln) 745 745 clname = clname(iln+1:LEN_TRIM(clname)) … … 765 765 clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix) 766 766 icnt = 0 767 INQUIRE( FILE = clname, EXIST = llok ) 767 INQUIRE( FILE = clname, EXIST = llok ) 768 768 ! we try different formats for the cpu number by adding 0 769 769 DO WHILE( .NOT.llok .AND. icnt < jpmax_digits ) … … 783 783 ! if no file was found... 784 784 IF( .NOT. llok ) THEN 785 IF( .NOT. llwrt ) THEN ! we are in read mode 785 IF( .NOT. llwrt ) THEN ! we are in read mode 786 786 IF( llstop ) THEN ; CALL ctl_stop( TRIM(clinfo), 'File '//TRIM(cltmpn)//'* not found' ) 787 787 ELSE ; istop = nstop + 1 ! make sure that istop /= nstop so we don't open the file 788 788 ENDIF 789 ELSE ! we are in write mode so we 789 ELSE ! we are in write mode so we 790 790 clname = cltmpn ! get back the file name without the cpu number 791 791 ENDIF 792 792 ELSE 793 IF( llwrt .AND. .NOT. ln_clobber ) THEN ! we stop as we want to write in a new file 793 IF( llwrt .AND. .NOT. ln_clobber ) THEN ! we stop as we want to write in a new file 794 794 CALL ctl_stop( TRIM(clinfo), 'We want to write in a new file but '//TRIM(clname)//' already exists...' ) 795 795 istop = nstop + 1 ! make sure that istop /= nstop so we don't open the file 796 ELSEIF( llwrt ) THEN ! the file exists and we are in write mode with permission to 796 ELSEIF( llwrt ) THEN ! the file exists and we are in write mode with permission to 797 797 clname = cltmpn ! overwrite so get back the file name without the cpu number 798 798 ENDIF … … 835 835 IF( iom_file(jf)%nfid > 0 ) THEN 836 836 CALL iom_nf90_close( jf ) 837 iom_file(jf)%nfid = 0 ! free the id 837 iom_file(jf)%nfid = 0 ! free the id 838 838 IF( PRESENT(kiomid) ) kiomid = 0 ! return 0 as id to specify that the file was closed 839 839 IF(lwp) WRITE(numout,*) TRIM(clinfo)//' close file: '//TRIM(iom_file(jf)%name)//' ok' … … 844 844 END DO 845 845 ENDIF 846 ! 846 ! 847 847 END SUBROUTINE iom_close 848 848 849 849 850 FUNCTION iom_varid ( kiomid, cdvar, kdimsz, kndims, lduld, ldstop ) 850 FUNCTION iom_varid ( kiomid, cdvar, kdimsz, kndims, lduld, ldstop ) 851 851 !!----------------------------------------------------------------------- 852 852 !! *** FUNCTION iom_varid *** … … 874 874 IF( kiomid > 0 ) THEN 875 875 clinfo = 'iom_varid, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(cdvar) 876 IF( iom_file(kiomid)%nfid == 0 ) THEN 876 IF( iom_file(kiomid)%nfid == 0 ) THEN 877 877 CALL ctl_stop( trim(clinfo), 'the file is not open' ) 878 878 ELSE … … 893 893 & 'increase the parameter jpmax_vars') 894 894 ENDIF 895 IF( llstop .AND. iom_varid == -1 ) CALL ctl_stop( TRIM(clinfo)//' not found' ) 895 IF( llstop .AND. iom_varid == -1 ) CALL ctl_stop( TRIM(clinfo)//' not found' ) 896 896 ELSE 897 897 iom_varid = iiv 898 IF( PRESENT(kdimsz) ) THEN 898 IF( PRESENT(kdimsz) ) THEN 899 899 i_nvd = iom_file(kiomid)%ndims(iiv) 900 900 IF( i_nvd <= size(kdimsz) ) THEN … … 1022 1022 REAL(dp) , ALLOCATABLE , DIMENSION(:) :: ztmp_pvar ! tmp var to read field 1023 1023 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 1024 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading 1024 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading 1025 1025 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kcount ! number of points in each axis 1026 1026 ! … … 1043 1043 REAL(dp) , INTENT( out), DIMENSION(:) :: pvar ! read field 1044 1044 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 1045 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading 1045 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading 1046 1046 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kcount ! number of points in each axis 1047 1047 ! … … 1062 1062 REAL(dp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.): (not) change sign across the north fold 1063 1063 INTEGER , INTENT(in ) , OPTIONAL :: kfill ! value of kfillmode in lbc_lbk 1064 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kstart ! start axis position of the reading 1064 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kstart ! start axis position of the reading 1065 1065 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kcount ! number of points in each axis 1066 1066 ! … … 1086 1086 REAL(dp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.): (not) change sign across the north fold 1087 1087 INTEGER , INTENT(in ) , OPTIONAL :: kfill ! value of kfillmode in lbc_lbk 1088 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kstart ! start axis position of the reading 1088 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kstart ! start axis position of the reading 1089 1089 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kcount ! number of points in each axis 1090 1090 ! … … 1106 1106 REAL(dp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.) : (not) change sign across the north fold 1107 1107 INTEGER , INTENT(in ) , OPTIONAL :: kfill ! value of kfillmode in lbc_lbk 1108 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kstart ! start axis position of the reading 1108 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kstart ! start axis position of the reading 1109 1109 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kcount ! number of points in each axis 1110 1110 ! … … 1130 1130 REAL(dp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.) : (not) change sign across the north fold 1131 1131 INTEGER , INTENT(in ) , OPTIONAL :: kfill ! value of kfillmode in lbc_lbk 1132 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kstart ! start axis position of the reading 1132 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kstart ! start axis position of the reading 1133 1133 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kcount ! number of points in each axis 1134 1134 ! … … 1163 1163 REAL(dp) , INTENT(in ), OPTIONAL :: psgn ! -1.(1.) : (not) change sign across the north fold 1164 1164 INTEGER , INTENT(in ), OPTIONAL :: kfill ! value of kfillmode in lbc_lbk 1165 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kstart ! start position of the reading in each axis 1165 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kstart ! start position of the reading in each axis 1166 1166 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kcount ! number of points to be read in each axis 1167 1167 ! 1168 1168 LOGICAL :: llok ! true if ok! 1169 INTEGER :: jl ! loop on number of dimension 1169 INTEGER :: jl ! loop on number of dimension 1170 1170 INTEGER :: idom ! type of domain 1171 1171 INTEGER :: idvar ! id of the variable 1172 1172 INTEGER :: inbdim ! number of dimensions of the variable 1173 INTEGER :: idmspc ! number of spatial dimensions 1173 INTEGER :: idmspc ! number of spatial dimensions 1174 1174 INTEGER :: itime ! record number 1175 1175 INTEGER :: istop ! temporary value of nstop 1176 1176 INTEGER :: ix1, ix2, iy1, iy2 ! subdomain indexes 1177 1177 INTEGER :: ji, jj ! loop counters 1178 INTEGER :: irankpv ! 1178 INTEGER :: irankpv ! 1179 1179 INTEGER :: ind1, ind2 ! substring index 1180 1180 INTEGER, DIMENSION(jpmax_dims) :: istart ! starting point to read for each axis 1181 INTEGER, DIMENSION(jpmax_dims) :: icnt ! number of value to read along each axis 1181 INTEGER, DIMENSION(jpmax_dims) :: icnt ! number of value to read along each axis 1182 1182 INTEGER, DIMENSION(jpmax_dims) :: idimsz ! size of the dimensions of the variable 1183 1183 INTEGER, DIMENSION(jpmax_dims) :: ishape ! size of the dimensions of the variable … … 1187 1187 CHARACTER(LEN=256) :: clinfo ! info character 1188 1188 CHARACTER(LEN=256) :: clname ! file name 1189 CHARACTER(LEN=1) :: clrankpv, cldmspc ! 1189 CHARACTER(LEN=1) :: clrankpv, cldmspc ! 1190 1190 CHARACTER(LEN=1) :: cl_type ! local value of cd_type 1191 1191 LOGICAL :: ll_only3rd ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension. … … 1215 1215 ! Search for the variable in the data base (eventually actualize data) 1216 1216 ! 1217 idvar = iom_varid( kiomid, cdvar ) 1217 idvar = iom_varid( kiomid, cdvar ) 1218 1218 IF( idvar > 0 ) THEN 1219 1219 ! … … 1222 1222 idmspc = inbdim ! number of spatial dimensions in the file 1223 1223 IF( iom_file(kiomid)%luld(idvar) ) idmspc = inbdim - 1 1224 IF( idmspc > 3 ) CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...') 1224 IF( idmspc > 3 ) CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...') 1225 1225 ! 1226 1226 ! Identify the domain in case of jpdom_auto definition 1227 IF( idom == jpdom_auto .OR. idom == jpdom_auto_xy ) THEN 1227 IF( idom == jpdom_auto .OR. idom == jpdom_auto_xy ) THEN 1228 1228 idom = jpdom_global ! default 1229 1229 ! else: if the file name finishes with _xxxx.nc with xxxx any number … … 1262 1262 CALL ctl_warn( trim(clinfo), '2D array input but 3 spatial dimensions in the file...' , & 1263 1263 & 'As the size of the z dimension is 1 and as we try to read the first record, ', & 1264 & 'we accept this case, even if there is a possible mix-up between z and time dimension' ) 1264 & 'we accept this case, even if there is a possible mix-up between z and time dimension' ) 1265 1265 idmspc = idmspc - 1 1266 1266 !!GS: possibility to read 3D ABL atmopsheric forcing and use 1st level to force BULK simulation … … 1274 1274 ! definition of istart and icnt 1275 1275 ! 1276 icnt (:) = 1 ! default definition (simple way to deal with special cases listed above) 1277 istart(:) = 1 ! default definition (simple way to deal with special cases listed above) 1276 icnt (:) = 1 ! default definition (simple way to deal with special cases listed above) 1277 istart(:) = 1 ! default definition (simple way to deal with special cases listed above) 1278 1278 istart(idmspc+1) = itime ! temporal dimenstion 1279 1279 ! 1280 1280 IF( idom == jpdom_unknown ) THEN 1281 IF( PRESENT(kstart) .AND. idom /= jpdom_auto_xy ) THEN 1282 istart(1:idmspc) = kstart(1:idmspc) 1281 IF( PRESENT(kstart) .AND. idom /= jpdom_auto_xy ) THEN 1282 istart(1:idmspc) = kstart(1:idmspc) 1283 1283 icnt (1:idmspc) = kcount(1:idmspc) 1284 1284 ELSE … … 1286 1286 ENDIF 1287 1287 ELSE ! not a 1D array as pv_r1d requires jpdom_unknown 1288 ! we do not read the overlap and the extra-halos -> from Nis0 to Nie0 and from Njs0 to Nje0 1288 ! we do not read the overlap and the extra-halos -> from Nis0 to Nie0 and from Njs0 to Nje0 1289 1289 IF( idom == jpdom_global ) istart(1:2) = (/ mig0(Nis0), mjg0(Njs0) /) 1290 1290 icnt(1:2) = (/ Ni_0, Nj_0 /) … … 1306 1306 WRITE( ctmp1, FMT="('(istart(', i1, ') + icnt(', i1, ') - 1) = ', i5)" ) jl, jl, itmp 1307 1307 WRITE( ctmp2, FMT="(' is larger than idimsz(', i1,') = ', i5)" ) jl, idimsz(jl) 1308 CALL ctl_stop( trim(clinfo), 'start and count too big regarding to the size of the data, ', ctmp1, ctmp2 ) 1308 CALL ctl_stop( trim(clinfo), 'start and count too big regarding to the size of the data, ', ctmp1, ctmp2 ) 1309 1309 ENDIF 1310 1310 END DO 1311 1311 ! 1312 1312 ! check that icnt matches the input array 1313 !- 1313 !- 1314 1314 IF( idom == jpdom_unknown ) THEN 1315 1315 IF( irankpv == 1 ) ishape(1:1) = SHAPE(pv_r1d) … … 1321 1321 ishape(1:2) = SHAPE(pv_r2d(Nis0:Nie0,Njs0:Nje0 )) ; ctmp1 = 'd(Nis0:Nie0,Njs0:Nje0)' 1322 1322 ENDIF 1323 IF( irankpv == 3 ) THEN 1323 IF( irankpv == 3 ) THEN 1324 1324 ishape(1:3) = SHAPE(pv_r3d(Nis0:Nie0,Njs0:Nje0,:)) ; ctmp1 = 'd(Nis0:Nie0,Njs0:Nje0,:)' 1325 1325 ENDIF 1326 ENDIF 1326 ENDIF 1327 1327 DO jl = 1, irankpv 1328 1328 WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl) … … 1333 1333 1334 1334 ! read the data 1335 !- 1335 !- 1336 1336 IF( idvar > 0 .AND. istop == nstop ) THEN ! no additional errors until this point... 1337 1337 ! … … 1340 1340 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 1341 1341 ENDIF 1342 1342 1343 1343 CALL iom_nf90_get( kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, pv_r1d, pv_r2d, pv_r3d ) 1344 1344 … … 1394 1394 CALL iom_swap(cxios_context) 1395 1395 #else 1396 istop = istop + 1 1396 istop = istop + 1 1397 1397 clinfo = 'Can not use XIOS in iom_get_123d, file: '//trim(clname)//', var:'//trim(cdvar) 1398 1398 #endif … … 1407 1407 zofs = iom_file(kiomid)%ofs(idvar) ! offset 1408 1408 IF( PRESENT(pv_r1d) ) THEN 1409 IF( zscf /= 1._wp ) pv_r1d(:) = pv_r1d(:) * zscf 1409 IF( zscf /= 1._wp ) pv_r1d(:) = pv_r1d(:) * zscf 1410 1410 IF( zofs /= 0._wp ) pv_r1d(:) = pv_r1d(:) + zofs 1411 1411 ELSEIF( PRESENT(pv_r2d) ) THEN … … 1421 1421 SUBROUTINE iom_get_var( cdname, z2d) 1422 1422 CHARACTER(LEN=*), INTENT(in ) :: cdname 1423 REAL(wp), DIMENSION(jpi,jpj) :: z2d 1423 REAL(wp), DIMENSION(jpi,jpj) :: z2d 1424 1424 #if defined key_iomput 1425 1425 IF( xios_field_is_active( cdname, at_current_timestep_arg = .TRUE. ) ) THEN … … 1433 1433 1434 1434 1435 FUNCTION iom_getszuld ( kiomid ) 1435 FUNCTION iom_getszuld ( kiomid ) 1436 1436 !!----------------------------------------------------------------------- 1437 1437 !! *** FUNCTION iom_getszuld *** … … 1449 1449 ENDIF 1450 1450 END FUNCTION iom_getszuld 1451 1451 1452 1452 1453 1453 !!---------------------------------------------------------------------- … … 1513 1513 ENDIF 1514 1514 END SUBROUTINE iom_g1d_ratt 1515 1515 1516 1516 SUBROUTINE iom_g0d_catt( kiomid, cdatt, cdatt0d, cdvar ) 1517 1517 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file … … 1572 1572 ENDIF 1573 1573 END SUBROUTINE iom_p1d_ratt 1574 1574 1575 1575 SUBROUTINE iom_p0d_catt( kiomid, cdatt, cdatt0d, cdvar ) 1576 1576 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file … … 1591 1591 INTEGER , INTENT(in) :: kt ! ocean time-step 1592 1592 INTEGER , INTENT(in) :: kwrite ! writing time-step 1593 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1593 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1594 1594 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1595 1595 REAL(sp) , INTENT(in) :: pvar ! written field … … 1614 1614 IF(lwp) write(numout,*) 'RESTART: define (XIOS 0D) ',trim(cdvar) 1615 1615 CALL iom_swap(context) 1616 CALL iom_set_rstw_active( trim(cdvar), rs0 = pvar ) 1616 CALL iom_set_rstw_active( trim(cdvar), rs0 = pvar ) 1617 1617 CALL iom_swap(cxios_context) 1618 1618 ENDIF … … 1631 1631 INTEGER , INTENT(in) :: kt ! ocean time-step 1632 1632 INTEGER , INTENT(in) :: kwrite ! writing time-step 1633 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1633 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1634 1634 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1635 1635 REAL(dp) , INTENT(in) :: pvar ! written field … … 1654 1654 IF(lwp) write(numout,*) 'RESTART: define (XIOS 0D) ',trim(cdvar) 1655 1655 CALL iom_swap(context) 1656 CALL iom_set_rstw_active( trim(cdvar), rd0 = pvar ) 1656 CALL iom_set_rstw_active( trim(cdvar), rd0 = pvar ) 1657 1657 CALL iom_swap(cxios_context) 1658 1658 ENDIF … … 1672 1672 INTEGER , INTENT(in) :: kt ! ocean time-step 1673 1673 INTEGER , INTENT(in) :: kwrite ! writing time-step 1674 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1674 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1675 1675 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1676 1676 REAL(sp) , INTENT(in), DIMENSION( :) :: pvar ! written field … … 1712 1712 INTEGER , INTENT(in) :: kt ! ocean time-step 1713 1713 INTEGER , INTENT(in) :: kwrite ! writing time-step 1714 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1714 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1715 1715 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1716 1716 REAL(dp) , INTENT(in), DIMENSION( :) :: pvar ! written field … … 1753 1753 INTEGER , INTENT(in) :: kt ! ocean time-step 1754 1754 INTEGER , INTENT(in) :: kwrite ! writing time-step 1755 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1755 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1756 1756 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1757 1757 REAL(sp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field … … 1793 1793 INTEGER , INTENT(in) :: kt ! ocean time-step 1794 1794 INTEGER , INTENT(in) :: kwrite ! writing time-step 1795 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1795 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1796 1796 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1797 1797 REAL(dp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field … … 1834 1834 INTEGER , INTENT(in) :: kt ! ocean time-step 1835 1835 INTEGER , INTENT(in) :: kwrite ! writing time-step 1836 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1836 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1837 1837 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1838 1838 REAL(sp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field … … 1874 1874 INTEGER , INTENT(in) :: kt ! ocean time-step 1875 1875 INTEGER , INTENT(in) :: kwrite ! writing time-step 1876 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1876 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1877 1877 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1878 1878 REAL(dp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field … … 1954 1954 ! 1955 1955 ENDIF 1956 1956 1957 1957 END SUBROUTINE iom_delay_rst 1958 1959 1958 1959 1960 1960 1961 1961 !!---------------------------------------------------------------------- … … 1969 1969 !!clem zz(:,:)=pfield0d 1970 1970 !!clem CALL xios_send_field(cdname, zz) 1971 CALL xios_send_field(cdname, (/pfield0d/)) 1971 CALL xios_send_field(cdname, (/pfield0d/)) 1972 1972 #else 1973 1973 IF( .FALSE. ) WRITE(numout,*) cdname, pfield0d ! useless test to avoid compilation warnings … … 1982 1982 !!clem zz(:,:)=pfield0d 1983 1983 !!clem CALL xios_send_field(cdname, zz) 1984 CALL xios_send_field(cdname, (/pfield0d/)) 1984 CALL xios_send_field(cdname, (/pfield0d/)) 1985 1985 #else 1986 1986 IF( .FALSE. ) WRITE(numout,*) cdname, pfield0d ! useless test to avoid compilation warnings … … 2126 2126 TYPE(xios_gridgroup) :: gridgroup_hdl 2127 2127 TYPE(xios_grid) :: grid_hdl 2128 TYPE(xios_domain) :: domain_hdl 2129 TYPE(xios_axis) :: axis_hdl 2128 TYPE(xios_domain) :: domain_hdl 2129 TYPE(xios_axis) :: axis_hdl 2130 2130 CHARACTER(LEN=64) :: cldomrefid ! domain_ref name 2131 2131 CHARACTER(len=1) :: cl1 ! last character of this name … … 2147 2147 CALL xios_add_child(grid_hdl, axis_hdl, 'depth'//cl1) ! add its axis 2148 2148 ENDIF 2149 ! 2149 ! 2150 2150 END SUBROUTINE iom_set_zoom_domain_attr 2151 2151 … … 2240 2240 !!---------------------------------------------------------------------- 2241 2241 !!---------------------------------------------------------------------- 2242 INTEGER , INTENT(in) :: kt 2242 INTEGER , INTENT(in) :: kt 2243 2243 CHARACTER(LEN=*), INTENT(in) :: cdname 2244 2244 !!---------------------------------------------------------------------- … … 2255 2255 !!---------------------------------------------------------------------- 2256 2256 clname = cdname 2257 IF( TRIM(Agrif_CFixed()) .NE. '0' ) clname = TRIM(Agrif_CFixed())//"_"//clname 2257 IF( TRIM(Agrif_CFixed()) .NE. '0' ) clname = TRIM(Agrif_CFixed())//"_"//clname 2258 2258 IF( xios_is_valid_context(clname) ) THEN 2259 2259 CALL iom_swap( cdname ) ! swap to cdname context … … 2281 2281 CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=Ni0glo,nj_glo=Nj0glo,ibegin=mig0(Nis0)-1,jbegin=mjg0(Njs0)-1,ni=Ni_0,nj=Nj_0) 2282 2282 CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = -nn_hls, data_ni=jpi, data_jbegin = -nn_hls, data_nj=jpj) 2283 !don't define lon and lat for restart reading context. 2283 !don't define lon and lat for restart reading context. 2284 2284 IF ( .NOT.ldrxios ) & 2285 2285 CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = real(RESHAPE(plon(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp), & 2286 & latvalue = real(RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp )) 2286 & latvalue = real(RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp )) 2287 2287 ! 2288 2288 IF ( ln_mskland .AND. (.NOT.ldxios) ) THEN … … 2384 2384 CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = -nn_hls, data_ni = jpi, data_jbegin = -nn_hls, data_nj = jpj) 2385 2385 CALL iom_set_domain_attr("gznl", lonvalue = real(zlon, dp), & 2386 & latvalue = real(RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp)) 2386 & latvalue = real(RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp)) 2387 2387 CALL iom_set_zoom_domain_attr("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=Nj0glo) 2388 2388 ! … … 2433 2433 TYPE(xios_duration) :: f_op, f_of 2434 2434 !!---------------------------------------------------------------------- 2435 ! 2435 ! 2436 2436 ! frequency of the call of iom_put (attribut: freq_op) 2437 2437 f_op%timestep = 1 ; f_of%timestep = 0 ; CALL iom_set_field_attr('field_definition', freq_op=f_op, freq_offset=f_of) … … 2444 2444 ! output file names (attribut: name) 2445 2445 DO ji = 1, 9 2446 WRITE(cl1,'(i1)') ji 2446 WRITE(cl1,'(i1)') ji 2447 2447 CALL iom_update_file_name('file'//cl1) 2448 2448 END DO 2449 2449 DO ji = 1, 99 2450 WRITE(cl2,'(i2.2)') ji 2450 WRITE(cl2,'(i2.2)') ji 2451 2451 CALL iom_update_file_name('file'//cl2) 2452 2452 END DO 2453 2453 DO ji = 1, 999 2454 WRITE(cl3,'(i3.3)') ji 2454 WRITE(cl3,'(i3.3)') ji 2455 2455 CALL iom_update_file_name('file'//cl3) 2456 2456 END DO 2457 2457 2458 2458 ! Zooms... 2459 clgrd = (/ 'T', 'U', 'W' /) 2459 clgrd = (/ 'T', 'U', 'W' /) 2460 2460 DO jg = 1, SIZE(clgrd) ! grid type 2461 2461 cl1 = clgrd(jg) … … 2522 2522 IF( zlon == -10. .AND. zlat == 4. ) THEN ; zlon = 0. ; zlat = 0. ; ENDIF 2523 2523 CALL dom_ngb( zlon, zlat, ix, iy, cl1 ) 2524 IF( zlon >= 0. ) THEN 2524 IF( zlon >= 0. ) THEN 2525 2525 IF( zlon == REAL(NINT(zlon), wp) ) THEN ; WRITE(clon, '(i3, a)') NINT( zlon), 'e' 2526 2526 ELSE ; WRITE(clon, '(f5.1,a)') zlon , 'e' 2527 2527 ENDIF 2528 ELSE 2528 ELSE 2529 2529 IF( zlon == REAL(NINT(zlon), wp) ) THEN ; WRITE(clon, '(i3, a)') NINT(-zlon), 'w' 2530 2530 ELSE ; WRITE(clon, '(f5.1,a)') -zlon , 'w' 2531 2531 ENDIF 2532 2532 ENDIF 2533 IF( zlat >= 0. ) THEN 2533 IF( zlat >= 0. ) THEN 2534 2534 IF( zlat == REAL(NINT(zlat), wp) ) THEN ; WRITE(clat, '(i2, a)') NINT( zlat), 'n' 2535 2535 ELSE ; WRITE(clat, '(f4.1,a)') zlat , 'n' 2536 2536 ENDIF 2537 ELSE 2537 ELSE 2538 2538 IF( zlat == REAL(NINT(zlat), wp) ) THEN ; WRITE(clat, '(i2, a)') NINT(-zlat), 's' 2539 2539 ELSE ; WRITE(clat, '(f4.1,a)') -zlat , 's' … … 2549 2549 END DO 2550 2550 END DO 2551 2551 2552 2552 END SUBROUTINE set_mooring 2553 2553 2554 2554 2555 2555 SUBROUTINE iom_update_file_name( cdid ) 2556 2556 !!---------------------------------------------------------------------- 2557 2557 !! *** ROUTINE iom_update_file_name *** 2558 2558 !! 2559 !! ** Purpose : 2559 !! ** Purpose : 2560 2560 !! 2561 2561 !!---------------------------------------------------------------------- … … 2571 2571 REAL(wp) :: zsec 2572 2572 LOGICAL :: llexist 2573 TYPE(xios_duration) :: output_freq 2573 TYPE(xios_duration) :: output_freq 2574 2574 !!---------------------------------------------------------------------- 2575 2575 ! … … 2580 2580 IF( jn == 2 ) CALL iom_get_file_attr( cdid, name_suffix = clname ) 2581 2581 ! 2582 IF ( TRIM(clname) /= '' ) THEN 2582 IF ( TRIM(clname) /= '' ) THEN 2583 2583 ! 2584 2584 idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@') 2585 DO WHILE ( idx /= 0 ) 2585 DO WHILE ( idx /= 0 ) 2586 2586 clname = clname(1:idx-1)//TRIM(cexper)//clname(idx+9:LEN_TRIM(clname)) 2587 2587 idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@') … … 2589 2589 ! 2590 2590 idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 2591 DO WHILE ( idx /= 0 ) 2591 DO WHILE ( idx /= 0 ) 2592 2592 IF ( output_freq%timestep /= 0) THEN 2593 WRITE(clfreq,'(I18,A2)')INT(output_freq%timestep),'ts' 2593 WRITE(clfreq,'(I18,A2)')INT(output_freq%timestep),'ts' 2594 2594 itrlen = LEN_TRIM(ADJUSTL(clfreq)) 2595 2595 ELSE IF ( output_freq%second /= 0 ) THEN 2596 WRITE(clfreq,'(I19,A1)')INT(output_freq%second),'s' 2596 WRITE(clfreq,'(I19,A1)')INT(output_freq%second),'s' 2597 2597 itrlen = LEN_TRIM(ADJUSTL(clfreq)) 2598 2598 ELSE IF ( output_freq%minute /= 0 ) THEN 2599 WRITE(clfreq,'(I18,A2)')INT(output_freq%minute),'mi' 2599 WRITE(clfreq,'(I18,A2)')INT(output_freq%minute),'mi' 2600 2600 itrlen = LEN_TRIM(ADJUSTL(clfreq)) 2601 2601 ELSE IF ( output_freq%hour /= 0 ) THEN 2602 WRITE(clfreq,'(I19,A1)')INT(output_freq%hour),'h' 2602 WRITE(clfreq,'(I19,A1)')INT(output_freq%hour),'h' 2603 2603 itrlen = LEN_TRIM(ADJUSTL(clfreq)) 2604 2604 ELSE IF ( output_freq%day /= 0 ) THEN 2605 WRITE(clfreq,'(I19,A1)')INT(output_freq%day),'d' 2605 WRITE(clfreq,'(I19,A1)')INT(output_freq%day),'d' 2606 2606 itrlen = LEN_TRIM(ADJUSTL(clfreq)) 2607 ELSE IF ( output_freq%month /= 0 ) THEN 2608 WRITE(clfreq,'(I19,A1)')INT(output_freq%month),'m' 2607 ELSE IF ( output_freq%month /= 0 ) THEN 2608 WRITE(clfreq,'(I19,A1)')INT(output_freq%month),'m' 2609 2609 itrlen = LEN_TRIM(ADJUSTL(clfreq)) 2610 ELSE IF ( output_freq%year /= 0 ) THEN 2611 WRITE(clfreq,'(I19,A1)')INT(output_freq%year),'y' 2610 ELSE IF ( output_freq%year /= 0 ) THEN 2611 WRITE(clfreq,'(I19,A1)')INT(output_freq%year),'y' 2612 2612 itrlen = LEN_TRIM(ADJUSTL(clfreq)) 2613 2613 ELSE … … 2620 2620 ! 2621 2621 idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 2622 DO WHILE ( idx /= 0 ) 2622 DO WHILE ( idx /= 0 ) 2623 2623 cldate = iom_sdate( fjulday - rn_Dt / rday ) 2624 2624 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+11:LEN_TRIM(clname)) … … 2627 2627 ! 2628 2628 idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@') 2629 DO WHILE ( idx /= 0 ) 2629 DO WHILE ( idx /= 0 ) 2630 2630 cldate = iom_sdate( fjulday - rn_Dt / rday, ldfull = .TRUE. ) 2631 2631 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+15:LEN_TRIM(clname)) … … 2634 2634 ! 2635 2635 idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') 2636 DO WHILE ( idx /= 0 ) 2636 DO WHILE ( idx /= 0 ) 2637 2637 cldate = iom_sdate( fjulday + rn_Dt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. ) 2638 2638 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+9:LEN_TRIM(clname)) … … 2641 2641 ! 2642 2642 idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') 2643 DO WHILE ( idx /= 0 ) 2643 DO WHILE ( idx /= 0 ) 2644 2644 cldate = iom_sdate( fjulday + rn_Dt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE., ldfull = .TRUE. ) 2645 2645 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+13:LEN_TRIM(clname)) … … 2669 2669 ! 2670 2670 CHARACTER(LEN=20) :: iom_sdate 2671 CHARACTER(LEN=50) :: clfmt ! format used to write the date 2671 CHARACTER(LEN=50) :: clfmt ! format used to write the date 2672 2672 INTEGER :: iyear, imonth, iday, ihour, iminute, isec 2673 2673 REAL(wp) :: zsec … … 2691 2691 ENDIF 2692 2692 ! 2693 IF( iyear < 10000 ) THEN ; clfmt = "i4.4,2i2.2" ! format used to write the date 2693 IF( iyear < 10000 ) THEN ; clfmt = "i4.4,2i2.2" ! format used to write the date 2694 2694 ELSE ; WRITE(clfmt, "('i',i1,',2i2.2')") INT(LOG10(REAL(iyear,wp))) + 1 2695 2695 ENDIF 2696 2696 ! 2697 !$AGRIF_DO_NOT_TREAT 2697 !$AGRIF_DO_NOT_TREAT 2698 2698 ! needed in the conv 2699 IF( llfull ) THEN 2699 IF( llfull ) THEN 2700 2700 clfmt = TRIM(clfmt)//",'_',i2.2,':',i2.2,':',i2.2" 2701 2701 ihour = isec / 3600 … … 2707 2707 WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday ! date of the end of run 2708 2708 ENDIF 2709 !$AGRIF_END_DO_NOT_TREAT 2709 !$AGRIF_END_DO_NOT_TREAT 2710 2710 ! 2711 2711 END FUNCTION iom_sdate … … 2716 2716 !!---------------------------------------------------------------------- 2717 2717 SUBROUTINE iom_setkt( kt, cdname ) 2718 INTEGER , INTENT(in):: kt 2718 INTEGER , INTENT(in):: kt 2719 2719 CHARACTER(LEN=*), INTENT(in) :: cdname 2720 2720 IF( .FALSE. ) WRITE(numout,*) kt, cdname ! useless test to avoid compilation warnings … … 2744 2744 SUBROUTINE iom_miss_val( cdname, pmiss_val ) 2745 2745 CHARACTER(LEN=*), INTENT(in ) :: cdname 2746 REAL(wp) , INTENT(out) :: pmiss_val 2747 REAL(dp) :: ztmp_pmiss_val 2746 REAL(wp) , INTENT(out) :: pmiss_val 2747 REAL(dp) :: ztmp_pmiss_val 2748 2748 #if defined key_iomput 2749 2749 ! get missing value … … 2755 2755 #endif 2756 2756 END SUBROUTINE iom_miss_val 2757 2757 2758 2758 !!====================================================================== 2759 2759 END MODULE iom
Note: See TracChangeset
for help on using the changeset viewer.
