- Timestamp:
- 2020-11-17T16:58:38+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/src/OCE/IOM/iom.F90
r13781 r13806 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 49 49 IMPLICIT NONE 50 50 PUBLIC ! must be public to be able to access iom_def through iom 51 51 52 52 #if defined key_iomput 53 53 LOGICAL, PUBLIC, PARAMETER :: lk_iomput = .TRUE. !: iom_put flag … … 91 91 MODULE PROCEDURE iom_p0d_dp, iom_p1d_dp, iom_p2d_dp, iom_p3d_dp, iom_p4d_dp 92 92 END INTERFACE iom_put 93 93 94 94 !! * Substitutions 95 95 # include "do_loop_substitute.h90" … … 101 101 CONTAINS 102 102 103 SUBROUTINE iom_init( cdname, fname, ld_closedef ) 103 SUBROUTINE iom_init( cdname, fname, ld_closedef ) 104 104 !!---------------------------------------------------------------------- 105 105 !! *** ROUTINE *** 106 106 !! 107 !! ** Purpose : 107 !! ** Purpose : 108 108 !! 109 109 !!---------------------------------------------------------------------- … … 136 136 llrst_context = (TRIM(cdname) == TRIM(crxios_context) .OR. TRIM(cdname) == TRIM(cwxios_context)) 137 137 138 ! Calendar type is now defined in xml file 138 ! Calendar type is now defined in xml file 139 139 IF (.NOT.(xios_getvar('ref_year' ,irefyear ))) irefyear = 1900 140 140 IF (.NOT.(xios_getvar('ref_month',irefmonth))) irefmonth = 01 … … 153 153 IF(.NOT.llrst_context) CALL set_scalar 154 154 ! 155 IF( TRIM(cdname) == TRIM(cxios_context) ) THEN 156 CALL set_grid( "T", glamt, gphit, .FALSE., .FALSE. ) 155 IF( TRIM(cdname) == TRIM(cxios_context) ) THEN 156 CALL set_grid( "T", glamt, gphit, .FALSE., .FALSE. ) 157 157 CALL set_grid( "U", glamu, gphiu, .FALSE., .FALSE. ) 158 158 CALL set_grid( "V", glamv, gphiv, .FALSE., .FALSE. ) … … 172 172 ENDIF 173 173 ! 174 IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN 174 IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN 175 175 CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain 176 176 ! 177 CALL set_grid( "T", glamt_crs, gphit_crs, .FALSE., .FALSE. ) 178 CALL set_grid( "U", glamu_crs, gphiu_crs, .FALSE., .FALSE. ) 179 CALL set_grid( "V", glamv_crs, gphiv_crs, .FALSE., .FALSE. ) 180 CALL set_grid( "W", glamt_crs, gphit_crs, .FALSE., .FALSE. ) 177 CALL set_grid( "T", glamt_crs, gphit_crs, .FALSE., .FALSE. ) 178 CALL set_grid( "U", glamu_crs, gphiu_crs, .FALSE., .FALSE. ) 179 CALL set_grid( "V", glamv_crs, gphiv_crs, .FALSE., .FALSE. ) 180 CALL set_grid( "W", glamt_crs, gphit_crs, .FALSE., .FALSE. ) 181 181 CALL set_grid_znl( gphit_crs ) 182 182 ! … … 203 203 204 204 ! ABL 205 IF( .NOT. ALLOCATED(ght_abl) ) THEN ! force definition for xml files (xios) 205 IF( .NOT. ALLOCATED(ght_abl) ) THEN ! force definition for xml files (xios) 206 206 ALLOCATE( ght_abl(jpka), ghw_abl(jpka), e3t_abl(jpka), e3w_abl(jpka) ) ! default allocation needed by iom 207 207 ght_abl(:) = -1._wp ; ghw_abl(:) = -1._wp … … 210 210 CALL iom_set_axis_attr( "ght_abl", ght_abl(2:jpka) ) 211 211 CALL iom_set_axis_attr( "ghw_abl", ghw_abl(2:jpka) ) 212 212 213 213 ! Add vertical grid bounds 214 214 zt_bnds(2,: ) = gdept_1d(:) … … 302 302 !! *** SUBROUTINE iom_set_rstw_var_active *** 303 303 !! 304 !! ** Purpose : enable variable in restart file when writing with XIOS 304 !! ** Purpose : enable variable in restart file when writing with XIOS 305 305 !!--------------------------------------------------------------------- 306 306 CHARACTER(len = *), INTENT(IN) :: field … … 313 313 314 314 DO i = 1, max_rst_fields 315 IF(TRIM(rst_wfields(i)%vname) == field) THEN 315 IF(TRIM(rst_wfields(i)%vname) == field) THEN 316 316 rst_wfields(i)%active = .TRUE. 317 317 llis_set = .TRUE. … … 321 321 !Warn if variable is not in defined in rst_wfields 322 322 IF(.NOT.llis_set) THEN 323 WRITE(ctmp1,*) 'iom_set_rstw_var_active: variable ', field ,' is available for writing but not defined' 323 WRITE(ctmp1,*) 'iom_set_rstw_var_active: variable ', field ,' is available for writing but not defined' 324 324 CALL ctl_stop( 'iom_set_rstw_var_active:', ctmp1 ) 325 325 ENDIF … … 336 336 !! 337 337 !! ** Purpose : define file name in XIOS context for reading restart file, 338 !! enable variables present in restart file for reading with XIOS 338 !! enable variables present in restart file for reading with XIOS 339 339 !!--------------------------------------------------------------------- 340 340 … … 374 374 CASE ("grid_N") 375 375 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 376 domain_ref="grid_N", operation = "instant") 376 domain_ref="grid_N", operation = "instant") 377 377 CASE ("grid_vector") 378 378 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & … … 393 393 !! *** SUBROUTINE iom_set_rstw_core *** 394 394 !! 395 !! ** Purpose : set variables which are always in restart file 395 !! ** Purpose : set variables which are always in restart file 396 396 !!--------------------------------------------------------------------- 397 397 CHARACTER (len=*), INTENT (IN) :: cdmdl ! model OPA or SAS … … 430 430 !! *** SUBROUTINE iom_set_rst_vars *** 431 431 !! 432 !! ** Purpose : Fill array fields with the information about all 433 !! possible variables and corresponding grids definition 432 !! ** Purpose : Fill array fields with the information about all 433 !! possible variables and corresponding grids definition 434 434 !! for reading/writing restart with XIOS 435 435 !!--------------------------------------------------------------------- … … 442 442 i = i + 1; fields(i)%vname="ub"; fields(i)%grid="grid_N_3D" 443 443 i = i + 1; fields(i)%vname="vn"; fields(i)%grid="grid_N_3D" 444 i = i + 1; fields(i)%vname="vb"; fields(i)%grid="grid_N_3D" 444 i = i + 1; fields(i)%vname="vb"; fields(i)%grid="grid_N_3D" 445 445 i = i + 1; fields(i)%vname="tn"; fields(i)%grid="grid_N_3D" 446 446 i = i + 1; fields(i)%vname="tb"; fields(i)%grid="grid_N_3D" … … 458 458 i = i + 1; fields(i)%vname="emp_b"; fields(i)%grid="grid_N" 459 459 i = i + 1; fields(i)%vname="sfx_b"; fields(i)%grid="grid_N" 460 i = i + 1; fields(i)%vname="en" ; fields(i)%grid="grid_N_3D" 460 i = i + 1; fields(i)%vname="en" ; fields(i)%grid="grid_N_3D" 461 461 i = i + 1; fields(i)%vname="avt_k"; fields(i)%grid="grid_N_3D" 462 462 i = i + 1; fields(i)%vname="avm_k"; fields(i)%grid="grid_N_3D" … … 565 565 CALL xios_get_handle("file_definition", filegroup_hdl ) 566 566 CALL xios_add_child(filegroup_hdl, file_hdl, 'wrestart') 567 IF(nxioso.eq.1) THEN 568 CALL xios_set_file_attr( "wrestart", type="one_file", enabled=.TRUE.,& 569 mode="write", output_freq=xios_timestep) 570 if(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in one_file mode' 571 ELSE 572 CALL xios_set_file_attr( "wrestart", type="multiple_file", enabled=.TRUE.,& 573 mode="write", output_freq=xios_timestep) 574 if(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in multiple_file mode' 575 ENDIF 567 IF(nxioso.eq.1) THEN 568 CALL xios_set_file_attr( "wrestart", type="one_file", enabled=.TRUE.,& 569 mode="write", output_freq=xios_timestep) 570 if(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in one_file mode' 571 ELSE 572 CALL xios_set_file_attr( "wrestart", type="multiple_file", enabled=.TRUE.,& 573 mode="write", output_freq=xios_timestep) 574 if(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in multiple_file mode' 575 ENDIF 576 576 CALL xios_set_file_attr( "wrestart", name=trim(cdrst_file)) 577 577 !define fields for restart context … … 585 585 CASE ("grid_N") 586 586 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 587 domain_ref="grid_N", prec = 8, operation = "instant") 587 domain_ref="grid_N", prec = 8, operation = "instant") 588 588 CASE ("grid_vector") 589 589 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & … … 598 598 END SUBROUTINE iom_set_rstw_active 599 599 600 SUBROUTINE iom_set_rst_context(ld_rstr) 600 SUBROUTINE iom_set_rst_context(ld_rstr) 601 601 !!--------------------------------------------------------------------- 602 602 !! *** SUBROUTINE iom_set_rst_context *** 603 603 !! 604 !! ** Purpose : Define domain, axis and grid for restart (read/write) 605 !! context 606 !! 604 !! ** Purpose : Define domain, axis and grid for restart (read/write) 605 !! context 606 !! 607 607 !!--------------------------------------------------------------------- 608 608 LOGICAL, INTENT(IN) :: ld_rstr 609 !ld_rstr is true for restart context. There is no need to define grid for 609 !ld_rstr is true for restart context. There is no need to define grid for 610 610 !restart read, because it's read from file 611 611 #if defined key_iomput 612 TYPE(xios_domaingroup) :: domaingroup_hdl 613 TYPE(xios_domain) :: domain_hdl 614 TYPE(xios_axisgroup) :: axisgroup_hdl 615 TYPE(xios_axis) :: axis_hdl 616 TYPE(xios_scalar) :: scalar_hdl 617 TYPE(xios_scalargroup) :: scalargroup_hdl 618 619 CALL xios_get_handle("domain_definition",domaingroup_hdl) 620 CALL xios_add_child(domaingroup_hdl, domain_hdl, "grid_N") 621 CALL set_grid("N", glamt, gphit, .TRUE., ld_rstr) 622 623 CALL xios_get_handle("axis_definition",axisgroup_hdl) 624 CALL xios_add_child(axisgroup_hdl, axis_hdl, "nav_lev") 612 TYPE(xios_domaingroup) :: domaingroup_hdl 613 TYPE(xios_domain) :: domain_hdl 614 TYPE(xios_axisgroup) :: axisgroup_hdl 615 TYPE(xios_axis) :: axis_hdl 616 TYPE(xios_scalar) :: scalar_hdl 617 TYPE(xios_scalargroup) :: scalargroup_hdl 618 619 CALL xios_get_handle("domain_definition",domaingroup_hdl) 620 CALL xios_add_child(domaingroup_hdl, domain_hdl, "grid_N") 621 CALL set_grid("N", glamt, gphit, .TRUE., ld_rstr) 622 623 CALL xios_get_handle("axis_definition",axisgroup_hdl) 624 CALL xios_add_child(axisgroup_hdl, axis_hdl, "nav_lev") 625 625 !AGRIF fails to compile when unit= is in call to xios_set_axis_attr 626 ! CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels", unit="m", positive="down") 626 ! CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels", unit="m", positive="down") 627 627 CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels in meters", positive="down") 628 CALL iom_set_axis_attr( "nav_lev", paxis = gdept_1d ) 629 630 CALL xios_get_handle("scalar_definition", scalargroup_hdl) 631 CALL xios_add_child(scalargroup_hdl, scalar_hdl, "grid_scalar") 628 CALL iom_set_axis_attr( "nav_lev", paxis = gdept_1d ) 629 630 CALL xios_get_handle("scalar_definition", scalargroup_hdl) 631 CALL xios_add_child(scalargroup_hdl, scalar_hdl, "grid_scalar") 632 632 #endif 633 633 END SUBROUTINE iom_set_rst_context … … 671 671 CHARACTER(LEN=256) :: clname ! the name of the file based on cdname [[+clcpu]+clcpu] 672 672 CHARACTER(LEN=256) :: cltmpn ! tempory name to store clname (in writting mode) 673 CHARACTER(LEN=10) :: clsuffix ! ".nc" 673 CHARACTER(LEN=10) :: clsuffix ! ".nc" 674 674 CHARACTER(LEN=15) :: clcpu ! the cpu number (max jpmax_digits digits) 675 675 CHARACTER(LEN=256) :: clinfo ! info character 676 LOGICAL :: llok ! check the existence 676 LOGICAL :: llok ! check the existence 677 677 LOGICAL :: llwrt ! local definition of ldwrt 678 678 LOGICAL :: llstop ! local definition of ldstop … … 680 680 INTEGER :: icnt ! counter for digits in clcpu (max = jpmax_digits) 681 681 INTEGER :: iln, ils ! lengths of character 682 INTEGER :: istop ! 682 INTEGER :: istop ! 683 683 ! local number of points for x,y dimensions 684 684 ! position of first local point for x,y dimensions … … 716 716 clname = trim(cdname) 717 717 IF ( .NOT. Agrif_Root() .AND. .NOT. lliof ) THEN 718 iln = INDEX(clname,'/') 718 iln = INDEX(clname,'/') 719 719 cltmpn = clname(1:iln) 720 720 clname = clname(iln+1:LEN_TRIM(clname)) … … 740 740 clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix) 741 741 icnt = 0 742 INQUIRE( FILE = clname, EXIST = llok ) 742 INQUIRE( FILE = clname, EXIST = llok ) 743 743 ! we try different formats for the cpu number by adding 0 744 744 DO WHILE( .NOT.llok .AND. icnt < jpmax_digits ) … … 758 758 ! if no file was found... 759 759 IF( .NOT. llok ) THEN 760 IF( .NOT. llwrt ) THEN ! we are in read mode 760 IF( .NOT. llwrt ) THEN ! we are in read mode 761 761 IF( llstop ) THEN ; CALL ctl_stop( TRIM(clinfo), 'File '//TRIM(cltmpn)//'* not found' ) 762 762 ELSE ; istop = nstop + 1 ! make sure that istop /= nstop so we don't open the file 763 763 ENDIF 764 ELSE ! we are in write mode so we 764 ELSE ! we are in write mode so we 765 765 clname = cltmpn ! get back the file name without the cpu number 766 766 ENDIF 767 767 ELSE 768 IF( llwrt .AND. .NOT. ln_clobber ) THEN ! we stop as we want to write in a new file 768 IF( llwrt .AND. .NOT. ln_clobber ) THEN ! we stop as we want to write in a new file 769 769 CALL ctl_stop( TRIM(clinfo), 'We want to write in a new file but '//TRIM(clname)//' already exists...' ) 770 770 istop = nstop + 1 ! make sure that istop /= nstop so we don't open the file 771 ELSEIF( llwrt ) THEN ! the file exists and we are in write mode with permission to 771 ELSEIF( llwrt ) THEN ! the file exists and we are in write mode with permission to 772 772 clname = cltmpn ! overwrite so get back the file name without the cpu number 773 773 ENDIF … … 810 810 IF( iom_file(jf)%nfid > 0 ) THEN 811 811 CALL iom_nf90_close( jf ) 812 iom_file(jf)%nfid = 0 ! free the id 812 iom_file(jf)%nfid = 0 ! free the id 813 813 IF( PRESENT(kiomid) ) kiomid = 0 ! return 0 as id to specify that the file was closed 814 814 IF(lwp) WRITE(numout,*) TRIM(clinfo)//' close file: '//TRIM(iom_file(jf)%name)//' ok' … … 819 819 END DO 820 820 ENDIF 821 ! 821 ! 822 822 END SUBROUTINE iom_close 823 823 824 824 825 FUNCTION iom_varid ( kiomid, cdvar, kdimsz, kndims, lduld, ldstop ) 825 FUNCTION iom_varid ( kiomid, cdvar, kdimsz, kndims, lduld, ldstop ) 826 826 !!----------------------------------------------------------------------- 827 827 !! *** FUNCTION iom_varid *** … … 849 849 IF( kiomid > 0 ) THEN 850 850 clinfo = 'iom_varid, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(cdvar) 851 IF( iom_file(kiomid)%nfid == 0 ) THEN 851 IF( iom_file(kiomid)%nfid == 0 ) THEN 852 852 CALL ctl_stop( trim(clinfo), 'the file is not open' ) 853 853 ELSE … … 868 868 & 'increase the parameter jpmax_vars') 869 869 ENDIF 870 IF( llstop .AND. iom_varid == -1 ) CALL ctl_stop( TRIM(clinfo)//' not found' ) 870 IF( llstop .AND. iom_varid == -1 ) CALL ctl_stop( TRIM(clinfo)//' not found' ) 871 871 ELSE 872 872 iom_varid = iiv 873 IF( PRESENT(kdimsz) ) THEN 873 IF( PRESENT(kdimsz) ) THEN 874 874 i_nvd = iom_file(kiomid)%ndims(iiv) 875 875 IF( i_nvd <= size(kdimsz) ) THEN … … 1001 1001 REAL(dp) , ALLOCATABLE , DIMENSION(:) :: ztmp_pvar ! tmp var to read field 1002 1002 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 1003 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading 1003 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading 1004 1004 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kcount ! number of points in each axis 1005 1005 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS … … 1024 1024 REAL(dp) , INTENT( out), DIMENSION(:) :: pvar ! read field 1025 1025 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 1026 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading 1026 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading 1027 1027 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kcount ! number of points in each axis 1028 1028 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS … … 1045 1045 REAL(dp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.): (not) change sign across the north fold 1046 1046 INTEGER , INTENT(in ) , OPTIONAL :: kfill ! value of kfillmode in lbc_lbk 1047 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kstart ! start axis position of the reading 1047 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kstart ! start axis position of the reading 1048 1048 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kcount ! number of points in each axis 1049 1049 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS … … 1070 1070 REAL(dp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.): (not) change sign across the north fold 1071 1071 INTEGER , INTENT(in ) , OPTIONAL :: kfill ! value of kfillmode in lbc_lbk 1072 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kstart ! start axis position of the reading 1072 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kstart ! start axis position of the reading 1073 1073 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kcount ! number of points in each axis 1074 1074 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS … … 1091 1091 REAL(dp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.) : (not) change sign across the north fold 1092 1092 INTEGER , INTENT(in ) , OPTIONAL :: kfill ! value of kfillmode in lbc_lbk 1093 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kstart ! start axis position of the reading 1093 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kstart ! start axis position of the reading 1094 1094 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kcount ! number of points in each axis 1095 1095 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS … … 1116 1116 REAL(dp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.) : (not) change sign across the north fold 1117 1117 INTEGER , INTENT(in ) , OPTIONAL :: kfill ! value of kfillmode in lbc_lbk 1118 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kstart ! start axis position of the reading 1118 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kstart ! start axis position of the reading 1119 1119 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kcount ! number of points in each axis 1120 1120 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS … … 1150 1150 REAL(dp) , INTENT(in ), OPTIONAL :: psgn ! -1.(1.) : (not) change sign across the north fold 1151 1151 INTEGER , INTENT(in ), OPTIONAL :: kfill ! value of kfillmode in lbc_lbk 1152 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kstart ! start position of the reading in each axis 1152 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kstart ! start position of the reading in each axis 1153 1153 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kcount ! number of points to be read in each axis 1154 1154 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use XIOS to read restart … … 1156 1156 LOGICAL :: llok ! true if ok! 1157 1157 LOGICAL :: llxios ! local definition for XIOS read 1158 INTEGER :: jl ! loop on number of dimension 1158 INTEGER :: jl ! loop on number of dimension 1159 1159 INTEGER :: idom ! type of domain 1160 1160 INTEGER :: idvar ! id of the variable 1161 1161 INTEGER :: inbdim ! number of dimensions of the variable 1162 INTEGER :: idmspc ! number of spatial dimensions 1162 INTEGER :: idmspc ! number of spatial dimensions 1163 1163 INTEGER :: itime ! record number 1164 1164 INTEGER :: istop ! temporary value of nstop 1165 1165 INTEGER :: ix1, ix2, iy1, iy2 ! subdomain indexes 1166 1166 INTEGER :: ji, jj ! loop counters 1167 INTEGER :: irankpv ! 1167 INTEGER :: irankpv ! 1168 1168 INTEGER :: ind1, ind2 ! substring index 1169 1169 INTEGER, DIMENSION(jpmax_dims) :: istart ! starting point to read for each axis 1170 INTEGER, DIMENSION(jpmax_dims) :: icnt ! number of value to read along each axis 1170 INTEGER, DIMENSION(jpmax_dims) :: icnt ! number of value to read along each axis 1171 1171 INTEGER, DIMENSION(jpmax_dims) :: idimsz ! size of the dimensions of the variable 1172 1172 INTEGER, DIMENSION(jpmax_dims) :: ishape ! size of the dimensions of the variable … … 1176 1176 CHARACTER(LEN=256) :: clinfo ! info character 1177 1177 CHARACTER(LEN=256) :: clname ! file name 1178 CHARACTER(LEN=1) :: clrankpv, cldmspc ! 1178 CHARACTER(LEN=1) :: clrankpv, cldmspc ! 1179 1179 CHARACTER(LEN=1) :: cl_type ! local value of cd_type 1180 1180 LOGICAL :: ll_only3rd ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension. … … 1205 1205 ! Search for the variable in the data base (eventually actualize data) 1206 1206 ! 1207 idvar = iom_varid( kiomid, cdvar ) 1207 idvar = iom_varid( kiomid, cdvar ) 1208 1208 IF( idvar > 0 ) THEN 1209 1209 ! … … 1212 1212 idmspc = inbdim ! number of spatial dimensions in the file 1213 1213 IF( iom_file(kiomid)%luld(idvar) ) idmspc = inbdim - 1 1214 IF( idmspc > 3 ) CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...') 1214 IF( idmspc > 3 ) CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...') 1215 1215 ! 1216 1216 ! Identify the domain in case of jpdom_auto definition 1217 IF( idom == jpdom_auto .OR. idom == jpdom_auto_xy ) THEN 1217 IF( idom == jpdom_auto .OR. idom == jpdom_auto_xy ) THEN 1218 1218 idom = jpdom_global ! default 1219 1219 ! else: if the file name finishes with _xxxx.nc with xxxx any number … … 1252 1252 CALL ctl_warn( trim(clinfo), '2D array input but 3 spatial dimensions in the file...' , & 1253 1253 & 'As the size of the z dimension is 1 and as we try to read the first record, ', & 1254 & 'we accept this case, even if there is a possible mix-up between z and time dimension' ) 1254 & 'we accept this case, even if there is a possible mix-up between z and time dimension' ) 1255 1255 idmspc = idmspc - 1 1256 1256 !!GS: possibility to read 3D ABL atmopsheric forcing and use 1st level to force BULK simulation … … 1264 1264 ! definition of istart and icnt 1265 1265 ! 1266 icnt (:) = 1 ! default definition (simple way to deal with special cases listed above) 1267 istart(:) = 1 ! default definition (simple way to deal with special cases listed above) 1266 icnt (:) = 1 ! default definition (simple way to deal with special cases listed above) 1267 istart(:) = 1 ! default definition (simple way to deal with special cases listed above) 1268 1268 istart(idmspc+1) = itime ! temporal dimenstion 1269 1269 ! 1270 1270 IF( idom == jpdom_unknown ) THEN 1271 IF( PRESENT(kstart) .AND. idom /= jpdom_auto_xy ) THEN 1272 istart(1:idmspc) = kstart(1:idmspc) 1271 IF( PRESENT(kstart) .AND. idom /= jpdom_auto_xy ) THEN 1272 istart(1:idmspc) = kstart(1:idmspc) 1273 1273 icnt (1:idmspc) = kcount(1:idmspc) 1274 1274 ELSE … … 1276 1276 ENDIF 1277 1277 ELSE ! not a 1D array as pv_r1d requires jpdom_unknown 1278 ! we do not read the overlap and the extra-halos -> from Nis0 to Nie0 and from Njs0 to Nje0 1278 ! we do not read the overlap and the extra-halos -> from Nis0 to Nie0 and from Njs0 to Nje0 1279 1279 IF( idom == jpdom_global ) istart(1:2) = (/ mig0(Nis0), mjg0(Njs0) /) 1280 1280 icnt(1:2) = (/ Ni_0, Nj_0 /) … … 1296 1296 WRITE( ctmp1, FMT="('(istart(', i1, ') + icnt(', i1, ') - 1) = ', i5)" ) jl, jl, itmp 1297 1297 WRITE( ctmp2, FMT="(' is larger than idimsz(', i1,') = ', i5)" ) jl, idimsz(jl) 1298 CALL ctl_stop( trim(clinfo), 'start and count too big regarding to the size of the data, ', ctmp1, ctmp2 ) 1298 CALL ctl_stop( trim(clinfo), 'start and count too big regarding to the size of the data, ', ctmp1, ctmp2 ) 1299 1299 ENDIF 1300 1300 END DO 1301 1301 ! 1302 1302 ! check that icnt matches the input array 1303 !- 1303 !- 1304 1304 IF( idom == jpdom_unknown ) THEN 1305 1305 IF( irankpv == 1 ) ishape(1:1) = SHAPE(pv_r1d) … … 1311 1311 ishape(1:2) = SHAPE(pv_r2d(Nis0:Nie0,Njs0:Nje0 )) ; ctmp1 = 'd(Nis0:Nie0,Njs0:Nje0)' 1312 1312 ENDIF 1313 IF( irankpv == 3 ) THEN 1313 IF( irankpv == 3 ) THEN 1314 1314 ishape(1:3) = SHAPE(pv_r3d(Nis0:Nie0,Njs0:Nje0,:)) ; ctmp1 = 'd(Nis0:Nie0,Njs0:Nje0,:)' 1315 1315 ENDIF 1316 ENDIF 1316 ENDIF 1317 1317 DO jl = 1, irankpv 1318 1318 WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl) … … 1323 1323 1324 1324 ! read the data 1325 !- 1325 !- 1326 1326 IF( idvar > 0 .AND. istop == nstop ) THEN ! no additional errors until this point... 1327 1327 ! … … 1330 1330 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 1331 1331 ENDIF 1332 1332 1333 1333 CALL iom_nf90_get( kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, pv_r1d, pv_r2d, pv_r3d ) 1334 1334 … … 1359 1359 #if defined key_iomput 1360 1360 !would be good to be able to check which context is active and swap only if current is not restart 1361 CALL iom_swap( TRIM(crxios_context) ) 1361 CALL iom_swap( TRIM(crxios_context) ) 1362 1362 IF( PRESENT(pv_r3d) ) THEN 1363 1363 IF(lwp) WRITE(numout,*) 'XIOS RST READ (3D): ',TRIM(cdvar) … … 1374 1374 CALL iom_swap( TRIM(cxios_context) ) 1375 1375 #else 1376 istop = istop + 1 1376 istop = istop + 1 1377 1377 clinfo = 'Can not use XIOS in iom_get_123d, file: '//trim(clname)//', var:'//trim(cdvar) 1378 1378 #endif … … 1387 1387 zofs = iom_file(kiomid)%ofs(idvar) ! offset 1388 1388 IF( PRESENT(pv_r1d) ) THEN 1389 IF( zscf /= 1. ) pv_r1d(:) = pv_r1d(:) * zscf 1389 IF( zscf /= 1. ) pv_r1d(:) = pv_r1d(:) * zscf 1390 1390 IF( zofs /= 0. ) pv_r1d(:) = pv_r1d(:) + zofs 1391 1391 ELSEIF( PRESENT(pv_r2d) ) THEN … … 1401 1401 SUBROUTINE iom_get_var( cdname, z2d) 1402 1402 CHARACTER(LEN=*), INTENT(in ) :: cdname 1403 REAL(wp), DIMENSION(jpi,jpj) :: z2d 1403 REAL(wp), DIMENSION(jpi,jpj) :: z2d 1404 1404 #if defined key_iomput 1405 1405 IF( xios_field_is_active( cdname, at_current_timestep_arg = .TRUE. ) ) THEN … … 1413 1413 1414 1414 1415 FUNCTION iom_getszuld ( kiomid ) 1415 FUNCTION iom_getszuld ( kiomid ) 1416 1416 !!----------------------------------------------------------------------- 1417 1417 !! *** FUNCTION iom_getszuld *** … … 1429 1429 ENDIF 1430 1430 END FUNCTION iom_getszuld 1431 1431 1432 1432 1433 1433 !!---------------------------------------------------------------------- … … 1493 1493 ENDIF 1494 1494 END SUBROUTINE iom_g1d_ratt 1495 1495 1496 1496 SUBROUTINE iom_g0d_catt( kiomid, cdatt, cdatt0d, cdvar ) 1497 1497 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file … … 1552 1552 ENDIF 1553 1553 END SUBROUTINE iom_p1d_ratt 1554 1554 1555 1555 SUBROUTINE iom_p0d_catt( kiomid, cdatt, cdatt0d, cdvar ) 1556 1556 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file … … 1571 1571 INTEGER , INTENT(in) :: kt ! ocean time-step 1572 1572 INTEGER , INTENT(in) :: kwrite ! writing time-step 1573 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1573 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1574 1574 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1575 1575 REAL(sp) , INTENT(in) :: pvar ! written field … … 1601 1601 INTEGER , INTENT(in) :: kt ! ocean time-step 1602 1602 INTEGER , INTENT(in) :: kwrite ! writing time-step 1603 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1603 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1604 1604 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1605 1605 REAL(dp) , INTENT(in) :: pvar ! written field … … 1632 1632 INTEGER , INTENT(in) :: kt ! ocean time-step 1633 1633 INTEGER , INTENT(in) :: kwrite ! writing time-step 1634 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1634 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1635 1635 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1636 1636 REAL(sp) , INTENT(in), DIMENSION( :) :: pvar ! written field … … 1662 1662 INTEGER , INTENT(in) :: kt ! ocean time-step 1663 1663 INTEGER , INTENT(in) :: kwrite ! writing time-step 1664 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1664 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1665 1665 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1666 1666 REAL(dp) , INTENT(in), DIMENSION( :) :: pvar ! written field … … 1693 1693 INTEGER , INTENT(in) :: kt ! ocean time-step 1694 1694 INTEGER , INTENT(in) :: kwrite ! writing time-step 1695 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1695 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1696 1696 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1697 1697 REAL(sp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field … … 1723 1723 INTEGER , INTENT(in) :: kt ! ocean time-step 1724 1724 INTEGER , INTENT(in) :: kwrite ! writing time-step 1725 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1725 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1726 1726 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1727 1727 REAL(dp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field … … 1754 1754 INTEGER , INTENT(in) :: kt ! ocean time-step 1755 1755 INTEGER , INTENT(in) :: kwrite ! writing time-step 1756 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1756 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1757 1757 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1758 1758 REAL(sp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field … … 1784 1784 INTEGER , INTENT(in) :: kt ! ocean time-step 1785 1785 INTEGER , INTENT(in) :: kwrite ! writing time-step 1786 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1786 INTEGER , INTENT(in) :: kiomid ! Identifier of the file 1787 1787 CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name 1788 1788 REAL(dp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field … … 1854 1854 ! 1855 1855 ENDIF 1856 1856 1857 1857 END SUBROUTINE iom_delay_rst 1858 1859 1858 1859 1860 1860 1861 1861 !!---------------------------------------------------------------------- … … 1869 1869 !!clem zz(:,:)=pfield0d 1870 1870 !!clem CALL xios_send_field(cdname, zz) 1871 CALL xios_send_field(cdname, (/pfield0d/)) 1871 CALL xios_send_field(cdname, (/pfield0d/)) 1872 1872 #else 1873 1873 IF( .FALSE. ) WRITE(numout,*) cdname, pfield0d ! useless test to avoid compilation warnings … … 1882 1882 !!clem zz(:,:)=pfield0d 1883 1883 !!clem CALL xios_send_field(cdname, zz) 1884 CALL xios_send_field(cdname, (/pfield0d/)) 1884 CALL xios_send_field(cdname, (/pfield0d/)) 1885 1885 #else 1886 1886 IF( .FALSE. ) WRITE(numout,*) cdname, pfield0d ! useless test to avoid compilation warnings … … 2026 2026 TYPE(xios_gridgroup) :: gridgroup_hdl 2027 2027 TYPE(xios_grid) :: grid_hdl 2028 TYPE(xios_domain) :: domain_hdl 2029 TYPE(xios_axis) :: axis_hdl 2028 TYPE(xios_domain) :: domain_hdl 2029 TYPE(xios_axis) :: axis_hdl 2030 2030 CHARACTER(LEN=64) :: cldomrefid ! domain_ref name 2031 2031 CHARACTER(len=1) :: cl1 ! last character of this name … … 2047 2047 CALL xios_add_child(grid_hdl, axis_hdl, 'depth'//cl1) ! add its axis 2048 2048 ENDIF 2049 ! 2049 ! 2050 2050 END SUBROUTINE iom_set_zoom_domain_attr 2051 2051 … … 2140 2140 !!---------------------------------------------------------------------- 2141 2141 !!---------------------------------------------------------------------- 2142 INTEGER , INTENT(in) :: kt 2142 INTEGER , INTENT(in) :: kt 2143 2143 CHARACTER(LEN=*), INTENT(in) :: cdname 2144 2144 !!---------------------------------------------------------------------- … … 2155 2155 !!---------------------------------------------------------------------- 2156 2156 clname = cdname 2157 IF( TRIM(Agrif_CFixed()) .NE. '0' ) clname = TRIM(Agrif_CFixed())//"_"//clname 2157 IF( TRIM(Agrif_CFixed()) .NE. '0' ) clname = TRIM(Agrif_CFixed())//"_"//clname 2158 2158 IF( xios_is_valid_context(clname) ) THEN 2159 2159 CALL iom_swap( cdname ) ! swap to cdname context … … 2181 2181 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) 2182 2182 CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = -nn_hls, data_ni = jpi, data_jbegin = -nn_hls, data_nj = jpj) 2183 !don't define lon and lat for restart reading context. 2183 !don't define lon and lat for restart reading context. 2184 2184 IF ( .NOT.ldrxios ) & 2185 2185 CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = real(RESHAPE(plon(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp), & 2186 & latvalue = real(RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp )) 2186 & latvalue = real(RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp )) 2187 2187 ! 2188 2188 IF ( ln_mskland .AND. (.NOT.ldxios) ) THEN … … 2281 2281 CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = -nn_hls, data_ni = jpi, data_jbegin = -nn_hls, data_nj = jpj) 2282 2282 CALL iom_set_domain_attr("gznl", lonvalue = real(zlon, dp), & 2283 & latvalue = real(RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp)) 2283 & latvalue = real(RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp)) 2284 2284 CALL iom_set_zoom_domain_attr("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=Nj0glo) 2285 2285 ! … … 2330 2330 TYPE(xios_duration) :: f_op, f_of 2331 2331 !!---------------------------------------------------------------------- 2332 ! 2332 ! 2333 2333 ! frequency of the call of iom_put (attribut: freq_op) 2334 2334 f_op%timestep = 1 ; f_of%timestep = 0 ; CALL iom_set_field_attr('field_definition', freq_op=f_op, freq_offset=f_of) … … 2341 2341 ! output file names (attribut: name) 2342 2342 DO ji = 1, 9 2343 WRITE(cl1,'(i1)') ji 2343 WRITE(cl1,'(i1)') ji 2344 2344 CALL iom_update_file_name('file'//cl1) 2345 2345 END DO 2346 2346 DO ji = 1, 99 2347 WRITE(cl2,'(i2.2)') ji 2347 WRITE(cl2,'(i2.2)') ji 2348 2348 CALL iom_update_file_name('file'//cl2) 2349 2349 END DO 2350 2350 DO ji = 1, 999 2351 WRITE(cl3,'(i3.3)') ji 2351 WRITE(cl3,'(i3.3)') ji 2352 2352 CALL iom_update_file_name('file'//cl3) 2353 2353 END DO 2354 2354 2355 2355 ! Zooms... 2356 clgrd = (/ 'T', 'U', 'W' /) 2356 clgrd = (/ 'T', 'U', 'W' /) 2357 2357 DO jg = 1, SIZE(clgrd) ! grid type 2358 2358 cl1 = clgrd(jg) … … 2419 2419 IF( zlon == -10. .AND. zlat == 4. ) THEN ; zlon = 0. ; zlat = 0. ; ENDIF 2420 2420 CALL dom_ngb( zlon, zlat, ix, iy, cl1 ) 2421 IF( zlon >= 0. ) THEN 2421 IF( zlon >= 0. ) THEN 2422 2422 IF( zlon == REAL(NINT(zlon), wp) ) THEN ; WRITE(clon, '(i3, a)') NINT( zlon), 'e' 2423 2423 ELSE ; WRITE(clon, '(f5.1,a)') zlon , 'e' 2424 2424 ENDIF 2425 ELSE 2425 ELSE 2426 2426 IF( zlon == REAL(NINT(zlon), wp) ) THEN ; WRITE(clon, '(i3, a)') NINT(-zlon), 'w' 2427 2427 ELSE ; WRITE(clon, '(f5.1,a)') -zlon , 'w' 2428 2428 ENDIF 2429 2429 ENDIF 2430 IF( zlat >= 0. ) THEN 2430 IF( zlat >= 0. ) THEN 2431 2431 IF( zlat == REAL(NINT(zlat), wp) ) THEN ; WRITE(clat, '(i2, a)') NINT( zlat), 'n' 2432 2432 ELSE ; WRITE(clat, '(f4.1,a)') zlat , 'n' 2433 2433 ENDIF 2434 ELSE 2434 ELSE 2435 2435 IF( zlat == REAL(NINT(zlat), wp) ) THEN ; WRITE(clat, '(i2, a)') NINT(-zlat), 's' 2436 2436 ELSE ; WRITE(clat, '(f4.1,a)') -zlat , 's' … … 2446 2446 END DO 2447 2447 END DO 2448 2448 2449 2449 END SUBROUTINE set_mooring 2450 2450 2451 2451 2452 2452 SUBROUTINE iom_update_file_name( cdid ) 2453 2453 !!---------------------------------------------------------------------- 2454 2454 !! *** ROUTINE iom_update_file_name *** 2455 2455 !! 2456 !! ** Purpose : 2456 !! ** Purpose : 2457 2457 !! 2458 2458 !!---------------------------------------------------------------------- … … 2468 2468 REAL(wp) :: zsec 2469 2469 LOGICAL :: llexist 2470 TYPE(xios_duration) :: output_freq 2470 TYPE(xios_duration) :: output_freq 2471 2471 !!---------------------------------------------------------------------- 2472 2472 ! … … 2477 2477 IF( jn == 2 ) CALL iom_get_file_attr( cdid, name_suffix = clname ) 2478 2478 ! 2479 IF ( TRIM(clname) /= '' ) THEN 2479 IF ( TRIM(clname) /= '' ) THEN 2480 2480 ! 2481 2481 idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@') 2482 DO WHILE ( idx /= 0 ) 2482 DO WHILE ( idx /= 0 ) 2483 2483 clname = clname(1:idx-1)//TRIM(cexper)//clname(idx+9:LEN_TRIM(clname)) 2484 2484 idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@') … … 2486 2486 ! 2487 2487 idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 2488 DO WHILE ( idx /= 0 ) 2488 DO WHILE ( idx /= 0 ) 2489 2489 IF ( output_freq%timestep /= 0) THEN 2490 WRITE(clfreq,'(I18,A2)')INT(output_freq%timestep),'ts' 2490 WRITE(clfreq,'(I18,A2)')INT(output_freq%timestep),'ts' 2491 2491 itrlen = LEN_TRIM(ADJUSTL(clfreq)) 2492 2492 ELSE IF ( output_freq%second /= 0 ) THEN 2493 WRITE(clfreq,'(I19,A1)')INT(output_freq%second),'s' 2493 WRITE(clfreq,'(I19,A1)')INT(output_freq%second),'s' 2494 2494 itrlen = LEN_TRIM(ADJUSTL(clfreq)) 2495 2495 ELSE IF ( output_freq%minute /= 0 ) THEN 2496 WRITE(clfreq,'(I18,A2)')INT(output_freq%minute),'mi' 2496 WRITE(clfreq,'(I18,A2)')INT(output_freq%minute),'mi' 2497 2497 itrlen = LEN_TRIM(ADJUSTL(clfreq)) 2498 2498 ELSE IF ( output_freq%hour /= 0 ) THEN 2499 WRITE(clfreq,'(I19,A1)')INT(output_freq%hour),'h' 2499 WRITE(clfreq,'(I19,A1)')INT(output_freq%hour),'h' 2500 2500 itrlen = LEN_TRIM(ADJUSTL(clfreq)) 2501 2501 ELSE IF ( output_freq%day /= 0 ) THEN 2502 WRITE(clfreq,'(I19,A1)')INT(output_freq%day),'d' 2502 WRITE(clfreq,'(I19,A1)')INT(output_freq%day),'d' 2503 2503 itrlen = LEN_TRIM(ADJUSTL(clfreq)) 2504 ELSE IF ( output_freq%month /= 0 ) THEN 2505 WRITE(clfreq,'(I19,A1)')INT(output_freq%month),'m' 2504 ELSE IF ( output_freq%month /= 0 ) THEN 2505 WRITE(clfreq,'(I19,A1)')INT(output_freq%month),'m' 2506 2506 itrlen = LEN_TRIM(ADJUSTL(clfreq)) 2507 ELSE IF ( output_freq%year /= 0 ) THEN 2508 WRITE(clfreq,'(I19,A1)')INT(output_freq%year),'y' 2507 ELSE IF ( output_freq%year /= 0 ) THEN 2508 WRITE(clfreq,'(I19,A1)')INT(output_freq%year),'y' 2509 2509 itrlen = LEN_TRIM(ADJUSTL(clfreq)) 2510 2510 ELSE … … 2517 2517 ! 2518 2518 idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 2519 DO WHILE ( idx /= 0 ) 2519 DO WHILE ( idx /= 0 ) 2520 2520 cldate = iom_sdate( fjulday - rn_Dt / rday ) 2521 2521 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+11:LEN_TRIM(clname)) … … 2524 2524 ! 2525 2525 idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@') 2526 DO WHILE ( idx /= 0 ) 2526 DO WHILE ( idx /= 0 ) 2527 2527 cldate = iom_sdate( fjulday - rn_Dt / rday, ldfull = .TRUE. ) 2528 2528 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+15:LEN_TRIM(clname)) … … 2531 2531 ! 2532 2532 idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') 2533 DO WHILE ( idx /= 0 ) 2533 DO WHILE ( idx /= 0 ) 2534 2534 cldate = iom_sdate( fjulday + rn_Dt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. ) 2535 2535 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+9:LEN_TRIM(clname)) … … 2538 2538 ! 2539 2539 idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') 2540 DO WHILE ( idx /= 0 ) 2540 DO WHILE ( idx /= 0 ) 2541 2541 cldate = iom_sdate( fjulday + rn_Dt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE., ldfull = .TRUE. ) 2542 2542 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+13:LEN_TRIM(clname)) … … 2566 2566 ! 2567 2567 CHARACTER(LEN=20) :: iom_sdate 2568 CHARACTER(LEN=50) :: clfmt ! format used to write the date 2568 CHARACTER(LEN=50) :: clfmt ! format used to write the date 2569 2569 INTEGER :: iyear, imonth, iday, ihour, iminute, isec 2570 2570 REAL(wp) :: zsec … … 2588 2588 ENDIF 2589 2589 ! 2590 IF( iyear < 10000 ) THEN ; clfmt = "i4.4,2i2.2" ! format used to write the date 2590 IF( iyear < 10000 ) THEN ; clfmt = "i4.4,2i2.2" ! format used to write the date 2591 2591 ELSE ; WRITE(clfmt, "('i',i1,',2i2.2')") INT(LOG10(REAL(iyear,wp))) + 1 2592 2592 ENDIF 2593 2593 ! 2594 !$AGRIF_DO_NOT_TREAT 2594 !$AGRIF_DO_NOT_TREAT 2595 2595 ! needed in the conv 2596 IF( llfull ) THEN 2596 IF( llfull ) THEN 2597 2597 clfmt = TRIM(clfmt)//",'_',i2.2,':',i2.2,':',i2.2" 2598 2598 ihour = isec / 3600 … … 2604 2604 WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday ! date of the end of run 2605 2605 ENDIF 2606 !$AGRIF_END_DO_NOT_TREAT 2606 !$AGRIF_END_DO_NOT_TREAT 2607 2607 ! 2608 2608 END FUNCTION iom_sdate … … 2613 2613 !!---------------------------------------------------------------------- 2614 2614 SUBROUTINE iom_setkt( kt, cdname ) 2615 INTEGER , INTENT(in):: kt 2615 INTEGER , INTENT(in):: kt 2616 2616 CHARACTER(LEN=*), INTENT(in) :: cdname 2617 2617 IF( .FALSE. ) WRITE(numout,*) kt, cdname ! useless test to avoid compilation warnings … … 2641 2641 SUBROUTINE iom_miss_val( cdname, pmiss_val ) 2642 2642 CHARACTER(LEN=*), INTENT(in ) :: cdname 2643 REAL(wp) , INTENT(out) :: pmiss_val 2644 REAL(dp) :: ztmp_pmiss_val 2643 REAL(wp) , INTENT(out) :: pmiss_val 2644 REAL(dp) :: ztmp_pmiss_val 2645 2645 #if defined key_iomput 2646 2646 ! get missing value … … 2652 2652 #endif 2653 2653 END SUBROUTINE iom_miss_val 2654 2654 2655 2655 !!====================================================================== 2656 2656 END MODULE iom
Note: See TracChangeset
for help on using the changeset viewer.
