Changeset 13899 for NEMO/branches/2020/tickets_icb_1900/src/OCE/IOM/iom.F90
- Timestamp:
- 2020-11-27T17:26:33+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/tickets_icb_1900
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/IOM/iom.F90 (modified) (42 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/tickets_icb_1900
- Property svn:externals
-
NEMO/branches/2020/tickets_icb_1900/src/OCE/IOM/iom.F90
r13226 r13899 21 21 !!---------------------------------------------------------------------- 22 22 USE dom_oce ! ocean space and time domain 23 USE domutl ! 23 24 USE c1d ! 1D vertical configuration 24 25 USE flo_oce ! floats module declarations … … 34 35 USE ice , ONLY : jpl 35 36 #endif 36 USE domngb ! ocean space and time domain37 37 USE phycst ! physical constants 38 38 USE dianam ! build name of file … … 101 101 CONTAINS 102 102 103 SUBROUTINE iom_init( cdname, fname, ld_ tmppatch, ld_closedef )103 SUBROUTINE iom_init( cdname, fname, ld_closedef ) 104 104 !!---------------------------------------------------------------------- 105 105 !! *** ROUTINE *** … … 110 110 CHARACTER(len=*), INTENT(in) :: cdname 111 111 CHARACTER(len=*), OPTIONAL, INTENT(in) :: fname 112 LOGICAL , OPTIONAL, INTENT(in) :: ld_tmppatch113 112 LOGICAL , OPTIONAL, INTENT(in) :: ld_closedef 114 113 #if defined key_iomput … … 123 122 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds 124 123 REAL(wp), DIMENSION(2,jpkam1) :: za_bnds ! ABL vertical boundaries 125 LOGICAL :: ll_tmppatch = .TRUE. !: seb: patch before we remove periodicity126 INTEGER :: nldi_save, nlei_save !: and close boundaries in output files127 INTEGER :: nldj_save, nlej_save !:128 124 LOGICAL :: ll_closedef = .TRUE. 129 !!---------------------------------------------------------------------- 130 ! 131 ! seb: patch before we remove periodicity and close boundaries in output files 132 IF( PRESENT(ld_tmppatch) ) THEN ; ll_tmppatch = ld_tmppatch 133 ELSE ; ll_tmppatch = .TRUE. 134 ENDIF 135 IF ( ll_tmppatch ) THEN 136 nldi_save = nldi ; nlei_save = nlei 137 nldj_save = nldj ; nlej_save = nlej 138 IF( nimpp == 1 ) nldi = 1 139 IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi 140 IF( njmpp == 1 ) nldj = 1 141 IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj 142 ENDIF 125 LOGICAL :: ll_exist 126 !!---------------------------------------------------------------------- 127 ! 143 128 IF ( PRESENT(ld_closedef) ) ll_closedef = ld_closedef 144 129 ! … … 157 142 158 143 SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL 159 CASE ( 1) ; CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(irefyear,irefmonth,irefday,00,00,00),&160 & start_date = xios_date(nyear,nmonth,nday,0,0,0) )161 CASE ( 0) ; CALL xios_define_calendar( TYPE = "NoLeap" , time_origin = xios_date(irefyear,irefmonth,irefday,00,00,00),&162 & start_date = xios_date(nyear,nmonth,nday,0,0,0) )163 CASE (30) ; CALL xios_define_calendar( TYPE = "D360" , time_origin = xios_date(irefyear,irefmonth,irefday,00,00,00),&164 & start_date = xios_date(nyear,nmonth,nday,0,0,0) )144 CASE ( 1) ; CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(irefyear,irefmonth,irefday,0,0,0), & 145 & start_date = xios_date( nyear, nmonth, nday,0,0,0) ) 146 CASE ( 0) ; CALL xios_define_calendar( TYPE = "NoLeap" , time_origin = xios_date(irefyear,irefmonth,irefday,0,0,0), & 147 & start_date = xios_date( nyear, nmonth, nday,0,0,0) ) 148 CASE (30) ; CALL xios_define_calendar( TYPE = "D360" , time_origin = xios_date(irefyear,irefmonth,irefday,0,0,0), & 149 & start_date = xios_date( nyear, nmonth, nday,0,0,0) ) 165 150 END SELECT 166 151 … … 176 161 ! 177 162 IF( ln_cfmeta ) THEN ! Add additional grid metadata 178 CALL iom_set_domain_attr("grid_T", area = real( e1e2t( nldi:nlei, nldj:nlej), dp))179 CALL iom_set_domain_attr("grid_U", area = real( e1e2u( nldi:nlei, nldj:nlej), dp))180 CALL iom_set_domain_attr("grid_V", area = real( e1e2v( nldi:nlei, nldj:nlej), dp))181 CALL iom_set_domain_attr("grid_W", area = real( e1e2t( nldi:nlei, nldj:nlej), dp))163 CALL iom_set_domain_attr("grid_T", area = real( e1e2t(Nis0:Nie0, Njs0:Nje0), dp)) 164 CALL iom_set_domain_attr("grid_U", area = real( e1e2u(Nis0:Nie0, Njs0:Nje0), dp)) 165 CALL iom_set_domain_attr("grid_V", area = real( e1e2v(Nis0:Nie0, Njs0:Nje0), dp)) 166 CALL iom_set_domain_attr("grid_W", area = real( e1e2t(Nis0:Nie0, Njs0:Nje0), dp)) 182 167 CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit ) 183 168 CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu ) … … 199 184 ! 200 185 IF( ln_cfmeta .AND. .NOT. llrst_context) THEN ! Add additional grid metadata 201 CALL iom_set_domain_attr("grid_T", area = real(e1e2t_crs( nldi:nlei, nldj:nlej), dp))202 CALL iom_set_domain_attr("grid_U", area = real(e1u_crs( nldi:nlei, nldj:nlej) * e2u_crs(nldi:nlei, nldj:nlej), dp))203 CALL iom_set_domain_attr("grid_V", area = real(e1v_crs( nldi:nlei, nldj:nlej) * e2v_crs(nldi:nlei, nldj:nlej), dp))204 CALL iom_set_domain_attr("grid_W", area = real(e1e2t_crs( nldi:nlei, nldj:nlej), dp ))186 CALL iom_set_domain_attr("grid_T", area = real(e1e2t_crs(Nis0:Nie0, Njs0:Nje0), dp)) 187 CALL iom_set_domain_attr("grid_U", area = real(e1u_crs(Nis0:Nie0, Njs0:Nje0) * e2u_crs(Nis0:Nie0, Njs0:Nje0), dp)) 188 CALL iom_set_domain_attr("grid_V", area = real(e1v_crs(Nis0:Nie0, Njs0:Nje0) * e2v_crs(Nis0:Nie0, Njs0:Nje0), dp)) 189 CALL iom_set_domain_attr("grid_W", area = real(e1e2t_crs(Nis0:Nie0, Njs0:Nje0), dp)) 205 190 CALL set_grid_bounds( "T", glamf_crs, gphif_crs, glamt_crs, gphit_crs ) 206 191 CALL set_grid_bounds( "U", glamv_crs, gphiv_crs, glamu_crs, gphiu_crs ) … … 246 231 CALL iom_set_axis_attr( "ghw_abl", bounds=za_bnds ) 247 232 248 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,jpnfl) /) )233 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,jpnfl) /) ) 249 234 # if defined key_si3 250 235 CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) ) … … 259 244 CALL iom_set_axis_attr( "iax_26C", (/ REAL(26,wp) /) ) ! strange syntaxe and idea... 260 245 CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) ) ! strange syntaxe and idea... 261 CALL iom_set_axis_attr( "basin" , (/ (REAL(ji,wp), ji=1,5) /) ) 246 ! for diaprt, we need to define an axis which size can be 1 (default) or 5 (if the file subbasins.nc exists) 247 INQUIRE( FILE = 'subbasins.nc', EXIST = ll_exist ) 248 nbasin = 1 + 4 * COUNT( (/ll_exist/) ) 249 CALL iom_set_axis_attr( "basin" , (/ (REAL(ji,wp), ji=1,nbasin) /) ) 262 250 ENDIF 263 251 ! … … 288 276 DEALLOCATE( zt_bnds, zw_bnds ) 289 277 ! 290 IF ( ll_tmppatch ) THEN291 nldi = nldi_save ; nlei = nlei_save292 nldj = nldj_save ; nlej = nlej_save293 ENDIF294 278 #endif 295 279 ! … … 370 354 rst_file = TRIM(clpath)//TRIM(cn_ocerst_in) 371 355 ELSE 372 rst_file = TRIM(clpath)// '1_'//TRIM(cn_ocerst_in)356 rst_file = TRIM(clpath)//TRIM(Agrif_CFixed())//'_'//TRIM(cn_ocerst_in) 373 357 ENDIF 374 358 !set name of the restart file and enable available fields … … 671 655 672 656 673 SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom,ldstop, ldiof, kdlev, cdcomp )657 SUBROUTINE iom_open( cdname, kiomid, ldwrt, ldstop, ldiof, kdlev, cdcomp ) 674 658 !!--------------------------------------------------------------------- 675 659 !! *** SUBROUTINE iom_open *** … … 680 664 INTEGER , INTENT( out) :: kiomid ! iom identifier of the opened file 681 665 LOGICAL , INTENT(in ), OPTIONAL :: ldwrt ! open in write modeb (default = .FALSE.) 682 INTEGER , INTENT(in ), OPTIONAL :: kdom ! Type of domain to be written (default = jpdom_local_noovlap)683 666 LOGICAL , INTENT(in ), OPTIONAL :: ldstop ! stop if open to read a non-existing file (default = .TRUE.) 684 667 LOGICAL , INTENT(in ), OPTIONAL :: ldiof ! Interp On the Fly, needed for AGRIF (default = .FALSE.) … … 693 676 LOGICAL :: llok ! check the existence 694 677 LOGICAL :: llwrt ! local definition of ldwrt 695 LOGICAL :: llnoov ! local definition to read overlap696 678 LOGICAL :: llstop ! local definition of ldstop 697 679 LOGICAL :: lliof ! local definition of ldiof 698 680 INTEGER :: icnt ! counter for digits in clcpu (max = jpmax_digits) 699 681 INTEGER :: iln, ils ! lengths of character 700 INTEGER :: idom ! type of domain701 682 INTEGER :: istop ! 702 INTEGER, DIMENSION(2,5) :: idompar ! domain parameters:703 683 ! local number of points for x,y dimensions 704 684 ! position of first local point for x,y dimensions … … 732 712 ELSE ; lliof = .FALSE. 733 713 ENDIF 734 ! do we read the overlap735 ! ugly patch SM+JMM+RB to overwrite global definition in some cases736 llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif737 714 ! create the file name by added, if needed, TRIM(Agrif_CFixed()) and TRIM(clsuffix) 738 715 ! ============= … … 773 750 ELSE 774 751 lxios_sini = .TRUE. 775 ENDIF776 IF( llwrt ) THEN777 ! check the domain definition778 ! JMM + SM: ugly patch before getting the new version of lib_mpp)779 ! idom = jpdom_local_noovlap ! default definition780 IF( llnoov ) THEN ; idom = jpdom_local_noovlap ! default definition781 ELSE ; idom = jpdom_local_full ! default definition782 ENDIF783 IF( PRESENT(kdom) ) idom = kdom784 ! create the domain informations785 ! =============786 SELECT CASE (idom)787 CASE (jpdom_local_full)788 idompar(:,1) = (/ jpi , jpj /)789 idompar(:,2) = (/ nimpp , njmpp /)790 idompar(:,3) = (/ nimpp + jpi - 1 , njmpp + jpj - 1 /)791 idompar(:,4) = (/ nldi - 1 , nldj - 1 /)792 idompar(:,5) = (/ jpi - nlei , jpj - nlej /)793 CASE (jpdom_local_noextra)794 idompar(:,1) = (/ nlci , nlcj /)795 idompar(:,2) = (/ nimpp , njmpp /)796 idompar(:,3) = (/ nimpp + nlci - 1, njmpp + nlcj - 1 /)797 idompar(:,4) = (/ nldi - 1 , nldj - 1 /)798 idompar(:,5) = (/ nlci - nlei , nlcj - nlej /)799 CASE (jpdom_local_noovlap)800 idompar(:,1) = (/ nlei - nldi + 1, nlej - nldj + 1 /)801 idompar(:,2) = (/ nimpp + nldi - 1, njmpp + nldj - 1 /)802 idompar(:,3) = (/ nimpp + nlei - 1, njmpp + nlej - 1 /)803 idompar(:,4) = (/ 0 , 0 /)804 idompar(:,5) = (/ 0 , 0 /)805 CASE DEFAULT806 CALL ctl_stop( TRIM(clinfo), 'wrong value of kdom, only jpdom_local* cases are accepted' )807 END SELECT808 752 ENDIF 809 753 ! Open the NetCDF file … … 830 774 ENDIF 831 775 IF( istop == nstop ) THEN ! no error within this routine 832 CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar,kdlev = kdlev, cdcomp = cdcomp )776 CALL iom_nf90_open( clname, kiomid, llwrt, llok, kdlev = kdlev, cdcomp = cdcomp ) 833 777 ENDIF 834 778 ! … … 1091 1035 END SUBROUTINE iom_g1d_dp 1092 1036 1093 SUBROUTINE iom_g2d_sp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios) 1094 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1095 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 1096 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 1097 REAL(sp) , INTENT( out), DIMENSION(:,:) :: pvar ! read field 1098 REAL(dp) , ALLOCATABLE , DIMENSION(:,:) :: ztmp_pvar ! tmp var to read field 1099 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 1100 INTEGER , INTENT(in ), DIMENSION(2) , OPTIONAL :: kstart ! start axis position of the reading 1101 INTEGER , INTENT(in ), DIMENSION(2) , OPTIONAL :: kcount ! number of points in each axis 1102 LOGICAL , INTENT(in ) , OPTIONAL :: lrowattr ! logical flag telling iom_get to 1103 ! look for and use a file attribute 1104 ! called open_ocean_jstart to set the start 1105 ! value for the 2nd dimension (netcdf only) 1106 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS 1037 SUBROUTINE iom_g2d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount, ldxios) 1038 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1039 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 1040 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 1041 REAL(sp) , INTENT( out), DIMENSION(:,:) :: pvar ! read field 1042 REAL(dp) , ALLOCATABLE , DIMENSION(:,:) :: ztmp_pvar ! tmp var to read field 1043 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 1044 CHARACTER(len=1), INTENT(in ) , OPTIONAL :: cd_type ! nature of grid-points (T, U, V, F, W) 1045 REAL(dp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.): (not) change sign across the north fold 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 1048 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kcount ! number of points in each axis 1049 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS 1107 1050 ! 1108 1051 IF( kiomid > 0 ) THEN 1109 1052 IF( iom_file(kiomid)%nfid > 0 ) THEN 1110 1053 ALLOCATE(ztmp_pvar(size(pvar,1), size(pvar,2))) 1111 CALL iom_get_123d( kiomid, kdom , cdvar , pv_r2d=ztmp_pvar, & 1112 & ktime=ktime, kstart=kstart, kcount=kcount, & 1113 & lrowattr=lrowattr, ldxios=ldxios) 1054 CALL iom_get_123d( kiomid, kdom, cdvar , pv_r2d = ztmp_pvar , ktime = ktime, & 1055 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 1056 & kstart = kstart , kcount = kcount, ldxios=ldxios ) 1057 pvar = ztmp_pvar 1058 DEALLOCATE(ztmp_pvar) 1059 ENDIF 1060 ENDIF 1061 END SUBROUTINE iom_g2d_sp 1062 1063 SUBROUTINE iom_g2d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount, ldxios) 1064 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1065 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 1066 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 1067 REAL(dp) , INTENT( out), DIMENSION(:,:) :: pvar ! read field 1068 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 1069 CHARACTER(len=1), INTENT(in ) , OPTIONAL :: cd_type ! nature of grid-points (T, U, V, F, W) 1070 REAL(dp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.): (not) change sign across the north fold 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 1073 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kcount ! number of points in each axis 1074 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS 1075 ! 1076 IF( kiomid > 0 ) THEN 1077 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom, cdvar , pv_r2d = pvar , ktime = ktime, & 1078 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 1079 & kstart = kstart , kcount = kcount, ldxios=ldxios ) 1080 ENDIF 1081 END SUBROUTINE iom_g2d_dp 1082 1083 SUBROUTINE iom_g3d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount, ldxios ) 1084 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1085 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 1086 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 1087 REAL(sp) , INTENT( out), DIMENSION(:,:,:) :: pvar ! read field 1088 REAL(dp) , ALLOCATABLE , DIMENSION(:,:,:) :: ztmp_pvar ! tmp var to read field 1089 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 1090 CHARACTER(len=1), INTENT(in ) , OPTIONAL :: cd_type ! nature of grid-points (T, U, V, F, W) 1091 REAL(dp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.) : (not) change sign across the north fold 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 1094 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kcount ! number of points in each axis 1095 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS 1096 ! 1097 IF( kiomid > 0 ) THEN 1098 IF( iom_file(kiomid)%nfid > 0 ) THEN 1099 ALLOCATE(ztmp_pvar(size(pvar,1), size(pvar,2), size(pvar,3))) 1100 CALL iom_get_123d( kiomid, kdom, cdvar , pv_r3d = ztmp_pvar , ktime = ktime, & 1101 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 1102 & kstart = kstart , kcount = kcount, ldxios=ldxios ) 1114 1103 pvar = ztmp_pvar 1115 1104 DEALLOCATE(ztmp_pvar) 1116 1105 END IF 1117 1106 ENDIF 1118 END SUBROUTINE iom_g2d_sp 1119 1120 1121 SUBROUTINE iom_g2d_dp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios) 1122 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1123 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 1124 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 1125 REAL(dp) , INTENT( out), DIMENSION(:,:) :: pvar ! read field 1126 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 1127 INTEGER , INTENT(in ), DIMENSION(2) , OPTIONAL :: kstart ! start axis position of the reading 1128 INTEGER , INTENT(in ), DIMENSION(2) , OPTIONAL :: kcount ! number of points in each axis 1129 LOGICAL , INTENT(in ) , OPTIONAL :: lrowattr ! logical flag telling iom_get to 1130 ! look for and use a file attribute 1131 ! called open_ocean_jstart to set the start 1132 ! value for the 2nd dimension (netcdf only) 1133 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS 1134 ! 1135 IF( kiomid > 0 ) THEN 1136 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r2d=pvar, & 1137 & ktime=ktime, kstart=kstart, kcount=kcount, & 1138 & lrowattr=lrowattr, ldxios=ldxios) 1139 ENDIF 1140 END SUBROUTINE iom_g2d_dp 1141 1142 SUBROUTINE iom_g3d_sp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios ) 1143 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1144 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 1145 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 1146 REAL(sp) , INTENT( out), DIMENSION(:,:,:) :: pvar ! read field 1147 REAL(dp) , ALLOCATABLE , DIMENSION(:,:,:) :: ztmp_pvar ! tmp var to read field 1148 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 1149 INTEGER , INTENT(in ), DIMENSION(3) , OPTIONAL :: kstart ! start axis position of the reading 1150 INTEGER , INTENT(in ), DIMENSION(3) , OPTIONAL :: kcount ! number of points in each axis 1151 LOGICAL , INTENT(in ) , OPTIONAL :: lrowattr ! logical flag telling iom_get to 1152 ! look for and use a file attribute 1153 ! called open_ocean_jstart to set the start 1154 ! value for the 2nd dimension (netcdf only) 1155 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS 1107 END SUBROUTINE iom_g3d_sp 1108 1109 SUBROUTINE iom_g3d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount, ldxios ) 1110 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1111 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 1112 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 1113 REAL(dp) , INTENT( out), DIMENSION(:,:,:) :: pvar ! read field 1114 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 1115 CHARACTER(len=1), INTENT(in ) , OPTIONAL :: cd_type ! nature of grid-points (T, U, V, F, W) 1116 REAL(dp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.) : (not) change sign across the north fold 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 1119 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kcount ! number of points in each axis 1120 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS 1156 1121 ! 1157 1122 IF( kiomid > 0 ) THEN 1158 1123 IF( iom_file(kiomid)%nfid > 0 ) THEN 1159 ALLOCATE(ztmp_pvar(size(pvar,1), size(pvar,2), size(pvar,3))) 1160 CALL iom_get_123d( kiomid, kdom , cdvar , pv_r3d=ztmp_pvar, & 1161 & ktime=ktime, kstart=kstart, kcount=kcount, & 1162 & lrowattr=lrowattr, ldxios=ldxios ) 1163 pvar = ztmp_pvar 1164 DEALLOCATE(ztmp_pvar) 1124 CALL iom_get_123d( kiomid, kdom, cdvar , pv_r3d = pvar , ktime = ktime, & 1125 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 1126 & kstart = kstart , kcount = kcount, ldxios=ldxios ) 1165 1127 END IF 1166 1128 ENDIF 1167 END SUBROUTINE iom_g3d_sp1168 1169 SUBROUTINE iom_g3d_dp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios )1170 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file1171 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read1172 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable1173 REAL(dp) , INTENT( out), DIMENSION(:,:,:) :: pvar ! read field1174 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number1175 INTEGER , INTENT(in ), DIMENSION(3) , OPTIONAL :: kstart ! start axis position of the reading1176 INTEGER , INTENT(in ), DIMENSION(3) , OPTIONAL :: kcount ! number of points in each axis1177 LOGICAL , INTENT(in ) , OPTIONAL :: lrowattr ! logical flag telling iom_get to1178 ! look for and use a file attribute1179 ! called open_ocean_jstart to set the start1180 ! value for the 2nd dimension (netcdf only)1181 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS1182 !1183 IF( kiomid > 0 ) THEN1184 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r3d=pvar, &1185 & ktime=ktime, kstart=kstart, kcount=kcount, &1186 & lrowattr=lrowattr, ldxios=ldxios )1187 ENDIF1188 1129 END SUBROUTINE iom_g3d_dp 1189 1130 1190 1191 1192 1131 !!---------------------------------------------------------------------- 1193 1132 1194 SUBROUTINE iom_get_123d( kiomid, kdom , cdvar , & 1195 & pv_r1d, pv_r2d, pv_r3d, & 1196 & ktime , kstart, kcount, & 1197 & lrowattr, ldxios ) 1133 SUBROUTINE iom_get_123d( kiomid , kdom, cdvar, pv_r1d, pv_r2d, pv_r3d, ktime , & 1134 & cd_type, psgn, kfill, kstart, kcount, ldxios ) 1198 1135 !!----------------------------------------------------------------------- 1199 1136 !! *** ROUTINE iom_get_123d *** … … 1203 1140 !! ** Method : read ONE record at each CALL 1204 1141 !!----------------------------------------------------------------------- 1205 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1206 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 1207 CHARACTER(len=*) , INTENT(in ) :: cdvar ! Name of the variable 1208 REAL(dp), DIMENSION(:) , INTENT( out), OPTIONAL :: pv_r1d ! read field (1D case) 1209 REAL(dp), DIMENSION(:,:) , INTENT( out), OPTIONAL :: pv_r2d ! read field (2D case) 1210 REAL(dp), DIMENSION(:,:,:) , INTENT( out), OPTIONAL :: pv_r3d ! read field (3D case) 1211 INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number 1212 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kstart ! start position of the reading in each axis 1213 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kcount ! number of points to be read in each axis 1214 LOGICAL , INTENT(in ), OPTIONAL :: lrowattr ! logical flag telling iom_get to 1215 ! look for and use a file attribute 1216 ! called open_ocean_jstart to set the start 1217 ! value for the 2nd dimension (netcdf only) 1218 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use XIOS to read restart 1219 ! 1220 LOGICAL :: llxios ! local definition for XIOS read 1221 LOGICAL :: llnoov ! local definition to read overlap 1222 LOGICAL :: luse_jattr ! local definition to read open_ocean_jstart file attribute 1223 INTEGER :: jstartrow ! start point for 2nd dimension optionally set by file attribute 1142 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1143 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 1144 CHARACTER(len=*) , INTENT(in ) :: cdvar ! Name of the variable 1145 REAL(dp), DIMENSION(:) , INTENT( out), OPTIONAL :: pv_r1d ! read field (1D case) 1146 REAL(dp), DIMENSION(:,:) , INTENT( out), OPTIONAL :: pv_r2d ! read field (2D case) 1147 REAL(dp), DIMENSION(:,:,:) , INTENT( out), OPTIONAL :: pv_r3d ! read field (3D case) 1148 INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number 1149 CHARACTER(len=1) , INTENT(in ), OPTIONAL :: cd_type ! nature of grid-points (T, U, V, F, W) 1150 REAL(dp) , INTENT(in ), OPTIONAL :: psgn ! -1.(1.) : (not) change sign across the north fold 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 1153 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kcount ! number of points to be read in each axis 1154 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use XIOS to read restart 1155 ! 1156 LOGICAL :: llok ! true if ok! 1157 LOGICAL :: llxios ! local definition for XIOS read 1224 1158 INTEGER :: jl ! loop on number of dimension 1225 1159 INTEGER :: idom ! type of domain … … 1238 1172 INTEGER, DIMENSION(jpmax_dims) :: ishape ! size of the dimensions of the variable 1239 1173 REAL(dp) :: zscf, zofs ! sacle_factor and add_offset 1174 REAL(wp) :: zsgn ! local value of psgn 1240 1175 INTEGER :: itmp ! temporary integer 1241 1176 CHARACTER(LEN=256) :: clinfo ! info character 1242 1177 CHARACTER(LEN=256) :: clname ! file name 1243 1178 CHARACTER(LEN=1) :: clrankpv, cldmspc ! 1244 LOGICAL :: ll_depth_spec ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension. 1179 CHARACTER(LEN=1) :: cl_type ! local value of cd_type 1180 LOGICAL :: ll_only3rd ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension. 1245 1181 INTEGER :: inlev ! number of levels for 3D data 1246 1182 REAL(dp) :: gma, gmi … … 1251 1187 ! 1252 1188 llxios = .FALSE. 1253 if(PRESENT(ldxios))llxios = ldxios1254 idvar = iom_varid( kiomid, cdvar )1189 IF( PRESENT(ldxios) ) llxios = ldxios 1190 ! 1255 1191 idom = kdom 1192 istop = nstop 1256 1193 ! 1257 1194 IF(.NOT.llxios) THEN 1258 1195 clname = iom_file(kiomid)%name ! esier to read 1259 1196 clinfo = ' iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar) 1260 ! local definition of the domain ?1261 ! do we read the overlap1262 ! ugly patch SM+JMM+RB to overwrite global definition in some cases1263 llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif1264 1197 ! check kcount and kstart optionals parameters... 1265 IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') 1266 IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 1267 IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND. idom /= jpdom_autoglo_xy ) & 1268 & CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown or kdom = jpdom_autoglo_xy') 1269 1270 luse_jattr = .false. 1271 IF( PRESENT(lrowattr) ) THEN 1272 IF( lrowattr .AND. idom /= jpdom_data ) CALL ctl_stop(trim(clinfo), 'lrowattr present and true needs kdom = jpdom_data') 1273 IF( lrowattr .AND. idom == jpdom_data ) luse_jattr = .true. 1274 ENDIF 1275 1198 IF( PRESENT(kcount) .AND. .NOT. PRESENT(kstart) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') 1199 IF( PRESENT(kstart) .AND. .NOT. PRESENT(kcount) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 1200 IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND. idom /= jpdom_auto_xy ) & 1201 & CALL ctl_stop(TRIM(clinfo), 'kstart present needs idom = jpdom_unknown or idom = jpdom_auto_xy') 1202 IF( idom == jpdom_auto_xy .AND. .NOT. PRESENT(kstart) ) & 1203 & CALL ctl_stop(TRIM(clinfo), 'idom = jpdom_auto_xy requires kstart to be present') 1204 ! 1276 1205 ! Search for the variable in the data base (eventually actualize data) 1277 istop = nstop1278 1206 ! 1207 idvar = iom_varid( kiomid, cdvar ) 1279 1208 IF( idvar > 0 ) THEN 1280 ! to write iom_file(kiomid)%dimsz in a shorter way !1281 idimsz(:) = iom_file(kiomid)%dimsz(:, idvar) 1209 ! 1210 idimsz(:) = iom_file(kiomid)%dimsz(:, idvar) ! to write iom_file(kiomid)%dimsz in a shorter way 1282 1211 inbdim = iom_file(kiomid)%ndims(idvar) ! number of dimensions in the file 1283 1212 idmspc = inbdim ! number of spatial dimensions in the file … … 1285 1214 IF( idmspc > 3 ) CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...') 1286 1215 ! 1287 ! update idom definition... 1288 ! Identify the domain in case of jpdom_auto(glo/dta) definition 1289 IF( idom == jpdom_autoglo_xy ) THEN 1290 ll_depth_spec = .TRUE. 1291 idom = jpdom_autoglo 1292 ELSE 1293 ll_depth_spec = .FALSE. 1294 ENDIF 1295 IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN 1296 IF( idom == jpdom_autoglo ) THEN ; idom = jpdom_global 1297 ELSE ; idom = jpdom_data 1298 ENDIF 1216 ! Identify the domain in case of jpdom_auto definition 1217 IF( idom == jpdom_auto .OR. idom == jpdom_auto_xy ) THEN 1218 idom = jpdom_global ! default 1219 ! else: if the file name finishes with _xxxx.nc with xxxx any number 1299 1220 ind1 = INDEX( clname, '_', back = .TRUE. ) + 1 1300 1221 ind2 = INDEX( clname, '.', back = .TRUE. ) - 1 1301 1222 IF( ind2 > ind1 ) THEN ; IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 ) idom = jpdom_local ; ENDIF 1302 ENDIF1303 ! Identify the domain in case of jpdom_local definition1304 IF( idom == jpdom_local ) THEN1305 IF( idimsz(1) == jpi .AND. idimsz(2) == jpj ) THEN ; idom = jpdom_local_full1306 ELSEIF( idimsz(1) == nlci .AND. idimsz(2) == nlcj ) THEN ; idom = jpdom_local_noextra1307 ELSEIF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN ; idom = jpdom_local_noovlap1308 ELSE ; CALL ctl_stop( trim(clinfo), 'impossible to identify the local domain' )1309 ENDIF1310 1223 ENDIF 1311 1224 ! … … 1320 1233 WRITE(cldmspc , fmt='(i1)') idmspc 1321 1234 ! 1322 !!GS: we consider 2D data as 3D data with vertical dim size = 1 1323 !IF( idmspc < irankpv ) THEN 1324 ! CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension', & 1325 ! & 'it is impossible to read a '//clrankpv//'D array from this file...' ) 1326 !ELSEIF( idmspc == irankpv ) THEN 1327 IF( idmspc == irankpv ) THEN 1235 IF( idmspc < irankpv ) THEN ! it seems we want to read more than we can... 1236 IF( irankpv == 3 .AND. idmspc == 2 ) THEN ! 3D input array from 2D spatial data in the file: 1237 llok = inlev == 1 ! -> 3rd dimension must be equal to 1 1238 ELSEIF( irankpv == 3 .AND. idmspc == 1 ) THEN ! 3D input array from 1D spatial data in the file: 1239 llok = inlev == 1 .AND. SIZE(pv_r3d, 2) == 1 ! -> 2nd and 3rd dimensions must be equal to 1 1240 ELSEIF( irankpv == 2 .AND. idmspc == 2 ) THEN ! 2D input array from 1D spatial data in the file: 1241 llok = SIZE(pv_r2d, 2) == 1 ! -> 2nd dimension must be equal to 1 1242 ELSE 1243 llok = .FALSE. 1244 ENDIF 1245 IF( .NOT. llok ) CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension', & 1246 & '=> cannot read a true '//clrankpv//'D array from this file...' ) 1247 ELSEIF( idmspc == irankpv ) THEN 1328 1248 IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown ) & 1329 1249 & CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' ) 1330 ELSEIF( idmspc > irankpv ) THEN 1250 ELSEIF( idmspc > irankpv ) THEN ! it seems we want to read less than we should... 1331 1251 IF( PRESENT(pv_r2d) .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN 1332 CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...' , &1252 CALL ctl_warn( trim(clinfo), '2D array input but 3 spatial dimensions in the file...' , & 1333 1253 & 'As the size of the z dimension is 1 and as we try to read the first record, ', & 1334 1254 & 'we accept this case, even if there is a possible mix-up between z and time dimension' ) … … 1344 1264 ! definition of istart and icnt 1345 1265 ! 1346 icnt (:) = 1 1347 istart(:) = 1 1348 istart(idmspc+1) = itime 1349 1350 IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN 1351 istart(1:idmspc) = kstart(1:idmspc) 1352 icnt (1:idmspc) = kcount(1:idmspc) 1353 ELSE 1354 IF(idom == jpdom_unknown ) THEN 1355 icnt(1:idmspc) = idimsz(1:idmspc) 1356 ELSE 1357 IF( .NOT. PRESENT(pv_r1d) ) THEN ! not a 1D array 1358 IF( idom == jpdom_data ) THEN 1359 jstartrow = 1 1360 IF( luse_jattr ) THEN 1361 CALL iom_getatt(kiomid, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found 1362 jstartrow = MAX(1,jstartrow) 1363 ENDIF 1364 istart(1:2) = (/ mig(1), mjg(1) + jstartrow - 1 /) ! icnt(1:2) done below 1365 ELSEIF( idom == jpdom_global ) THEN ; istart(1:2) = (/ nimpp , njmpp /) ! icnt(1:2) done below 1366 ENDIF 1367 ! we do not read the overlap -> we start to read at nldi, nldj 1368 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 1369 ! IF( idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 1370 IF( llnoov .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 1371 ! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej 1372 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 1373 ! icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 1374 IF( llnoov ) THEN ; icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 1375 ELSE ; icnt(1:2) = (/ nlci , nlcj /) 1376 ENDIF 1377 IF( PRESENT(pv_r3d) ) THEN 1378 IF( idom == jpdom_data ) THEN ; icnt(3) = inlev 1379 ELSEIF( ll_depth_spec .AND. PRESENT(kstart) ) THEN ; istart(3) = kstart(3) ; icnt(3) = kcount(3) 1380 ELSE ; icnt(3) = inlev 1381 ENDIF 1382 ENDIF 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 istart(idmspc+1) = itime ! temporal dimenstion 1269 ! 1270 IF( idom == jpdom_unknown ) THEN 1271 IF( PRESENT(kstart) .AND. idom /= jpdom_auto_xy ) THEN 1272 istart(1:idmspc) = kstart(1:idmspc) 1273 icnt (1:idmspc) = kcount(1:idmspc) 1274 ELSE 1275 icnt (1:idmspc) = idimsz(1:idmspc) 1276 ENDIF 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 1279 IF( idom == jpdom_global ) istart(1:2) = (/ mig0(Nis0), mjg0(Njs0) /) 1280 icnt(1:2) = (/ Ni_0, Nj_0 /) 1281 IF( PRESENT(pv_r3d) ) THEN 1282 IF( idom == jpdom_auto_xy ) THEN 1283 istart(3) = kstart(3) 1284 icnt (3) = kcount(3) 1285 ELSE 1286 icnt (3) = inlev 1383 1287 ENDIF 1384 1288 ENDIF 1385 1289 ENDIF 1386 1290 ! 1387 1291 ! check that istart and icnt can be used with this file 1388 1292 !- … … 1395 1299 ENDIF 1396 1300 END DO 1397 1301 ! 1398 1302 ! check that icnt matches the input array 1399 1303 !- … … 1405 1309 ELSE 1406 1310 IF( irankpv == 2 ) THEN 1407 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 1408 ! ishape(1:2) = SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1 = 'd(nldi:nlei,nldj:nlej)' 1409 IF( llnoov ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1='d(nldi:nlei,nldj:nlej)' 1410 ELSE ; ishape(1:2)=SHAPE(pv_r2d(1 :nlci,1 :nlcj )) ; ctmp1='d(1:nlci,1:nlcj)' 1411 ENDIF 1311 ishape(1:2) = SHAPE(pv_r2d(Nis0:Nie0,Njs0:Nje0 )) ; ctmp1 = 'd(Nis0:Nie0,Njs0:Nje0)' 1412 1312 ENDIF 1413 1313 IF( irankpv == 3 ) THEN 1414 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 1415 ! ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1 = 'd(nldi:nlei,nldj:nlej,:)' 1416 IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)' 1417 ELSE ; ishape(1:3)=SHAPE(pv_r3d(1 :nlci,1 :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)' 1418 ENDIF 1314 ishape(1:3) = SHAPE(pv_r3d(Nis0:Nie0,Njs0:Nje0,:)) ; ctmp1 = 'd(Nis0:Nie0,Njs0:Nje0,:)' 1419 1315 ENDIF 1420 ENDIF 1421 1316 ENDIF 1422 1317 DO jl = 1, irankpv 1423 1318 WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl) … … 1431 1326 IF( idvar > 0 .AND. istop == nstop ) THEN ! no additional errors until this point... 1432 1327 ! 1433 ! find the right index of the array to be read 1434 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 1435 ! IF( idom /= jpdom_unknown ) THEN ; ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej 1436 ! ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 1437 ! ENDIF 1438 IF( llnoov ) THEN 1439 IF( idom /= jpdom_unknown ) THEN ; ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej 1440 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 1441 ENDIF 1442 ELSE 1443 IF( idom /= jpdom_unknown ) THEN ; ix1 = 1 ; ix2 = nlci ; iy1 = 1 ; iy2 = nlcj 1444 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 1445 ENDIF 1328 ! find the right index of the array to be read 1329 IF( idom /= jpdom_unknown ) THEN ; ix1 = Nis0 ; ix2 = Nie0 ; iy1 = Njs0 ; iy2 = Nje0 1330 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 1446 1331 ENDIF 1447 1332 … … 1450 1335 IF( istop == nstop ) THEN ! no additional errors until this point... 1451 1336 IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name) 1452 1337 1338 cl_type = 'T' 1339 IF( PRESENT(cd_type) ) cl_type = cd_type 1340 zsgn = 1._wp 1341 IF( PRESENT(psgn ) ) zsgn = psgn 1453 1342 !--- overlap areas and extra hallows (mpp) 1454 IF( PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 1455 CALL lbc_lnk( 'iom', pv_r2d,'Z', -999.0_wp, kfillmode = jpfillnothing ) 1456 ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 1457 ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 1458 IF( icnt(3) == inlev ) THEN 1459 CALL lbc_lnk( 'iom', pv_r3d,'Z', -999.0_wp, kfillmode = jpfillnothing ) 1460 ELSE ! put some arbitrary value (a call to lbc_lnk will be done later...) 1461 DO jj = nlcj+1, jpj ; pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :) ; END DO 1462 DO ji = nlci+1, jpi ; pv_r3d(ji , : , :) = pv_r3d(nlei , : , :) ; END DO 1463 ENDIF 1343 IF( PRESENT(pv_r2d) .AND. idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN 1344 CALL lbc_lnk( 'iom', pv_r2d, cl_type, zsgn, kfillmode = kfill ) 1345 ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN 1346 CALL lbc_lnk( 'iom', pv_r3d, cl_type, zsgn, kfillmode = kfill ) 1464 1347 ENDIF 1465 1348 ! … … 1478 1361 CALL iom_swap( TRIM(crxios_context) ) 1479 1362 IF( PRESENT(pv_r3d) ) THEN 1480 pv_r3d(:, :, :) = 0. 1481 if(lwp) write(numout,*) 'XIOS RST READ (3D): ',trim(cdvar) 1363 IF(lwp) WRITE(numout,*) 'XIOS RST READ (3D): ',TRIM(cdvar) 1482 1364 CALL xios_recv_field( trim(cdvar), pv_r3d) 1483 IF(idom /= jpdom_unknown ) then 1484 CALL lbc_lnk( 'iom', pv_r3d,'Z', -999.0_wp, kfillmode = jpfillnothing) 1485 ENDIF 1365 IF(idom /= jpdom_unknown ) CALL lbc_lnk( 'iom', pv_r3d,'Z', -999., kfillmode = jpfillnothing) 1486 1366 ELSEIF( PRESENT(pv_r2d) ) THEN 1487 pv_r2d(:, :) = 0. 1488 if(lwp) write(numout,*) 'XIOS RST READ (2D): ', trim(cdvar) 1367 IF(lwp) WRITE(numout,*) 'XIOS RST READ (2D): ', TRIM(cdvar) 1489 1368 CALL xios_recv_field( trim(cdvar), pv_r2d) 1490 IF(idom /= jpdom_unknown ) THEN 1491 CALL lbc_lnk('iom', pv_r2d,'Z',-999.0_wp, kfillmode = jpfillnothing) 1492 ENDIF 1369 IF(idom /= jpdom_unknown ) CALL lbc_lnk('iom', pv_r2d,'Z',-999., kfillmode = jpfillnothing) 1493 1370 ELSEIF( PRESENT(pv_r1d) ) THEN 1494 pv_r1d(:) = 0. 1495 if(lwp) write(numout,*) 'XIOS RST READ (1D): ', trim(cdvar) 1371 IF(lwp) WRITE(numout,*) 'XIOS RST READ (1D): ', TRIM(cdvar) 1496 1372 CALL xios_recv_field( trim(cdvar), pv_r1d) 1497 1373 ENDIF … … 2036 1912 CHARACTER(LEN=*) , INTENT(in) :: cdname 2037 1913 REAL(sp), DIMENSION(:,:), INTENT(in) :: pfield2d 2038 #if defined key_iomput 2039 CALL xios_send_field(cdname, pfield2d) 1914 IF( iom_use(cdname) ) THEN 1915 #if defined key_iomput 1916 CALL xios_send_field( cdname, pfield2d ) 2040 1917 #else 2041 IF( .FALSE. ) WRITE(numout,*) cdname, pfield2d ! useless test to avoid compilation warnings 2042 #endif 1918 WRITE(numout,*) pfield2d ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 1919 #endif 1920 ENDIF 2043 1921 END SUBROUTINE iom_p2d_sp 2044 1922 … … 2046 1924 CHARACTER(LEN=*) , INTENT(in) :: cdname 2047 1925 REAL(dp), DIMENSION(:,:), INTENT(in) :: pfield2d 2048 #if defined key_iomput 2049 CALL xios_send_field(cdname, pfield2d) 1926 IF( iom_use(cdname) ) THEN 1927 #if defined key_iomput 1928 CALL xios_send_field( cdname, pfield2d ) 2050 1929 #else 2051 IF( .FALSE. ) WRITE(numout,*) cdname, pfield2d ! useless test to avoid compilation warnings 2052 #endif 1930 WRITE(numout,*) pfield2d ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 1931 #endif 1932 ENDIF 2053 1933 END SUBROUTINE iom_p2d_dp 2054 1934 … … 2056 1936 CHARACTER(LEN=*) , INTENT(in) :: cdname 2057 1937 REAL(sp), DIMENSION(:,:,:), INTENT(in) :: pfield3d 2058 #if defined key_iomput 2059 CALL xios_send_field( cdname, pfield3d ) 1938 IF( iom_use(cdname) ) THEN 1939 #if defined key_iomput 1940 CALL xios_send_field( cdname, pfield3d ) 2060 1941 #else 2061 IF( .FALSE. ) WRITE(numout,*) cdname, pfield3d ! useless test to avoid compilation warnings 2062 #endif 1942 WRITE(numout,*) pfield3d ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 1943 #endif 1944 ENDIF 2063 1945 END SUBROUTINE iom_p3d_sp 2064 1946 … … 2066 1948 CHARACTER(LEN=*) , INTENT(in) :: cdname 2067 1949 REAL(dp), DIMENSION(:,:,:), INTENT(in) :: pfield3d 2068 #if defined key_iomput 2069 CALL xios_send_field( cdname, pfield3d ) 1950 IF( iom_use(cdname) ) THEN 1951 #if defined key_iomput 1952 CALL xios_send_field( cdname, pfield3d ) 2070 1953 #else 2071 IF( .FALSE. ) WRITE(numout,*) cdname, pfield3d ! useless test to avoid compilation warnings 2072 #endif 1954 WRITE(numout,*) pfield3d ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 1955 #endif 1956 ENDIF 2073 1957 END SUBROUTINE iom_p3d_dp 2074 1958 … … 2076 1960 CHARACTER(LEN=*) , INTENT(in) :: cdname 2077 1961 REAL(sp), DIMENSION(:,:,:,:), INTENT(in) :: pfield4d 2078 #if defined key_iomput 2079 CALL xios_send_field(cdname, pfield4d) 1962 IF( iom_use(cdname) ) THEN 1963 #if defined key_iomput 1964 CALL xios_send_field (cdname, pfield4d ) 2080 1965 #else 2081 IF( .FALSE. ) WRITE(numout,*) cdname, pfield4d ! useless test to avoid compilation warnings 2082 #endif 1966 WRITE(numout,*) pfield4d ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 1967 #endif 1968 ENDIF 2083 1969 END SUBROUTINE iom_p4d_sp 2084 1970 … … 2086 1972 CHARACTER(LEN=*) , INTENT(in) :: cdname 2087 1973 REAL(dp), DIMENSION(:,:,:,:), INTENT(in) :: pfield4d 2088 #if defined key_iomput 2089 CALL xios_send_field(cdname, pfield4d) 1974 IF( iom_use(cdname) ) THEN 1975 #if defined key_iomput 1976 CALL xios_send_field (cdname, pfield4d ) 2090 1977 #else 2091 IF( .FALSE. ) WRITE(numout,*) cdname, pfield4d ! useless test to avoid compilation warnings 2092 #endif 1978 WRITE(numout,*) pfield4d ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 1979 #endif 1980 ENDIF 2093 1981 END SUBROUTINE iom_p4d_dp 2094 1982 … … 2287 2175 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plat 2288 2176 ! 2289 INTEGER :: ni, nj2290 2177 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask 2291 2178 LOGICAL, INTENT(IN) :: ldxios, ldrxios 2292 2179 !!---------------------------------------------------------------------- 2293 2180 ! 2294 ni = nlei-nldi+1 2295 nj = nlej-nldj+1 2296 ! 2297 CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 2298 CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 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 CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = -nn_hls, data_ni = jpi, data_jbegin = -nn_hls, data_nj = jpj) 2299 2183 !don't define lon and lat for restart reading context. 2300 2184 IF ( .NOT.ldrxios ) & 2301 CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = real(RESHAPE(plon( nldi:nlei, nldj:nlej),(/ ni*nj /)),dp), &2302 & latvalue = real(RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)),dp ))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 )) 2303 2187 ! 2304 2188 IF ( ln_mskland .AND. (.NOT.ldxios) ) THEN … … 2306 2190 SELECT CASE ( cdgrd ) 2307 2191 CASE('T') ; zmask(:,:,:) = tmask(:,:,:) 2308 CASE('U') ; zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:) ; CALL lbc_lnk( 'iom', zmask, 'U', 1.0_wp )2309 CASE('V') ; zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:) ; CALL lbc_lnk( 'iom', zmask, 'V', 1.0_wp )2192 CASE('U') ; zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:) 2193 CASE('V') ; zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:) 2310 2194 CASE('W') ; zmask(:,:,2:jpk ) = tmask(:,:,1:jpkm1) + tmask(:,:,2:jpk) ; zmask(:,:,1) = tmask(:,:,1) 2311 2195 END SELECT 2312 2196 ! 2313 CALL iom_set_domain_attr( "grid_"//cdgrd , mask = RESHAPE(zmask( nldi:nlei,nldj:nlej,1),(/ni*nj/)) /= 0. )2314 CALL iom_set_grid_attr ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask( nldi:nlei,nldj:nlej,:),(/ni,nj,jpk/)) /= 0. )2197 CALL iom_set_domain_attr( "grid_"//cdgrd , mask = RESHAPE(zmask(Nis0:Nie0,Njs0:Nje0,1),(/Ni_0*Nj_0 /)) /= 0. ) 2198 CALL iom_set_grid_attr ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(Nis0:Nie0,Njs0:Nje0,:),(/Ni_0,Nj_0,jpk/)) /= 0. ) 2315 2199 ENDIF 2316 2200 ! 2317 2201 END SUBROUTINE set_grid 2318 2319 2202 2320 2203 SUBROUTINE set_grid_bounds( cdgrd, plon_cnr, plat_cnr, plon_pnt, plat_pnt ) … … 2329 2212 REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt ! Lat/lon coord. of the point of cell (i,j) 2330 2213 ! 2331 INTEGER :: ji, jj, jn , ni, nj2214 INTEGER :: ji, jj, jn 2332 2215 INTEGER :: icnr, jcnr ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 2333 ! ! represents the bottom-left corner of cell (i,j) 2216 ! ! represents the 2217 ! bottom-left corner of 2218 ! cell (i,j) 2334 2219 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z_bnds ! Lat/lon coordinates of the vertices of cell (i,j) 2335 2220 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_fld ! Working array to determine where to rotate cells … … 2346 2231 END SELECT 2347 2232 ! 2348 ni = nlei-nldi+1 ! Dimensions of subdomain interior2349 nj = nlej-nldj+12350 !2351 2233 z_fld(:,:) = 1._wp 2352 2234 CALL lbc_lnk( 'iom', z_fld, cdgrd, -1.0_wp ) ! Working array for location of northfold 2353 2235 ! 2354 2236 ! Cell vertices that can be defined 2355 DO jj = 2, jpjm1 2356 DO ji = 2, jpim1 2357 z_bnds(1,ji,jj,1) = plat_cnr(ji+icnr, jj+jcnr ) ! Bottom-left 2358 z_bnds(2,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr ) ! Bottom-right 2359 z_bnds(3,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 2360 z_bnds(4,ji,jj,1) = plat_cnr(ji+icnr, jj+jcnr+1) ! Top-left 2361 z_bnds(1,ji,jj,2) = plon_cnr(ji+icnr, jj+jcnr ) ! Bottom-left 2362 z_bnds(2,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr ) ! Bottom-right 2363 z_bnds(3,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 2364 z_bnds(4,ji,jj,2) = plon_cnr(ji+icnr, jj+jcnr+1) ! Top-left 2365 END DO 2366 END DO 2367 ! 2368 ! Cell vertices on boundries 2369 DO jn = 1, 4 2370 CALL lbc_lnk( 'iom', z_bnds(jn,:,:,1), cdgrd, 1.0_wp, pfillval=999._wp ) 2371 CALL lbc_lnk( 'iom', z_bnds(jn,:,:,2), cdgrd, 1.0_wp, pfillval=999._wp ) 2372 END DO 2373 ! 2374 ! Zero-size cells at closed boundaries if cell points provided, 2375 ! otherwise they are closed cells with unrealistic bounds 2376 IF( PRESENT(plon_pnt) .AND. PRESENT(plat_pnt) ) THEN 2377 IF( (nbondi == -1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN 2378 DO jn = 1, 4 ! (West or jpni = 1), closed E-W 2379 z_bnds(jn,1,:,1) = plat_pnt(1,:) ; z_bnds(jn,1,:,2) = plon_pnt(1,:) 2380 END DO 2237 DO_2D( 0, 0, 0, 0 ) 2238 z_bnds(1,ji,jj,1) = plat_cnr(ji+icnr, jj+jcnr ) ! Bottom-left 2239 z_bnds(2,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr ) ! Bottom-right 2240 z_bnds(3,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 2241 z_bnds(4,ji,jj,1) = plat_cnr(ji+icnr, jj+jcnr+1) ! Top-left 2242 z_bnds(1,ji,jj,2) = plon_cnr(ji+icnr, jj+jcnr ) ! Bottom-left 2243 z_bnds(2,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr ) ! Bottom-right 2244 z_bnds(3,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 2245 z_bnds(4,ji,jj,2) = plon_cnr(ji+icnr, jj+jcnr+1) ! Top-left 2246 END_2D 2247 ! 2248 DO_2D( 0, 0, 0, 0 ) 2249 IF( z_fld(ji,jj) == -1. ) THEN 2250 z_rot(1,:) = z_bnds(3,ji,jj,:) ; z_rot(2,:) = z_bnds(4,ji,jj,:) 2251 z_rot(3,:) = z_bnds(1,ji,jj,:) ; z_rot(4,:) = z_bnds(2,ji,jj,:) 2252 z_bnds(:,ji,jj,:) = z_rot(:,:) 2381 2253 ENDIF 2382 IF( (nbondi == 1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN 2383 DO jn = 1, 4 ! (East or jpni = 1), closed E-W 2384 z_bnds(jn,nlci,:,1) = plat_pnt(nlci,:) ; z_bnds(jn,nlci,:,2) = plon_pnt(nlci,:) 2385 END DO 2386 ENDIF 2387 IF( nbondj == -1 .OR. (nbondj == 2 .AND. jperio /= 2) ) THEN 2388 DO jn = 1, 4 ! South or (jpnj = 1, not symmetric) 2389 z_bnds(jn,:,1,1) = plat_pnt(:,1) ; z_bnds(jn,:,1,2) = plon_pnt(:,1) 2390 END DO 2391 ENDIF 2392 IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio < 3 ) THEN 2393 DO jn = 1, 4 ! (North or jpnj = 1), no north fold 2394 z_bnds(jn,:,nlcj,1) = plat_pnt(:,nlcj) ; z_bnds(jn,:,nlcj,2) = plon_pnt(:,nlcj) 2395 END DO 2396 ENDIF 2397 ENDIF 2398 ! 2399 IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio >= 3 ) THEN ! Rotate cells at the north fold 2400 DO jj = 1, jpj 2401 DO ji = 1, jpi 2402 IF( z_fld(ji,jj) == -1. ) THEN 2403 z_rot(1,:) = z_bnds(3,ji,jj,:) ; z_rot(2,:) = z_bnds(4,ji,jj,:) 2404 z_rot(3,:) = z_bnds(1,ji,jj,:) ; z_rot(4,:) = z_bnds(2,ji,jj,:) 2405 z_bnds(:,ji,jj,:) = z_rot(:,:) 2406 ENDIF 2407 END DO 2408 END DO 2409 ELSE IF( nbondj == 2 .AND. jperio == 2 ) THEN ! Invert cells at the symmetric equator 2410 DO ji = 1, jpi 2411 z_rot(1:2,:) = z_bnds(3:4,ji,1,:) 2412 z_rot(3:4,:) = z_bnds(1:2,ji,1,:) 2413 z_bnds(:,ji,1,:) = z_rot(:,:) 2414 END DO 2415 ENDIF 2416 ! 2417 CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat =real( RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,1),(/ 4,ni*nj /)), dp), & 2418 & bounds_lon =real( RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,2),(/ 4,ni*nj /)), dp), nvertex=4 ) 2419 ! 2420 DEALLOCATE( z_bnds, z_fld, z_rot ) 2254 END_2D 2255 ! 2256 CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = real(RESHAPE(z_bnds(:,Nis0:Nie0,Njs0:Nje0,1),(/ 4,Ni_0*Nj_0 /)), dp), & 2257 & bounds_lon = real(RESHAPE(z_bnds(:,Nis0:Nie0,Njs0:Nje0,2),(/ 4,Ni_0*Nj_0 /)), dp), nvertex=4 ) 2258 ! 2259 DEALLOCATE( z_bnds, z_fld, z_rot ) 2421 2260 ! 2422 2261 END SUBROUTINE set_grid_bounds 2423 2262 2424 2425 2263 SUBROUTINE set_grid_znl( plat ) 2426 2264 !!---------------------------------------------------------------------- … … 2432 2270 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plat 2433 2271 ! 2434 INTEGER :: ni, nj,ix, iy2272 INTEGER :: ix, iy 2435 2273 REAL(wp), DIMENSION(:), ALLOCATABLE :: zlon 2436 2274 !!---------------------------------------------------------------------- 2437 2275 ! 2438 ni=nlei-nldi+1 ! define zonal mean domain (jpj*jpk) 2439 nj=nlej-nldj+1 2440 ALLOCATE( zlon(ni*nj) ) ; zlon(:) = 0._wp 2276 ALLOCATE( zlon(Ni_0*Nj_0) ) ; zlon(:) = 0._wp 2441 2277 ! 2442 2278 ! CALL dom_ngb( -168.53_wp, 65.03_wp, ix, iy, 'T' ) ! i-line that passes through Bering Strait: Reference latitude (used in plots) 2443 2279 CALL dom_ngb( 180.0_wp, 90.0_wp, ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots) 2444 CALL iom_set_domain_attr("gznl", ni_glo= jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj)2445 CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)2280 CALL iom_set_domain_attr("gznl", ni_glo=Ni0glo, nj_glo=Nj0glo, ibegin=mig0(Nis0)-1, jbegin=mjg0(Njs0)-1, ni=Ni_0, nj=Nj_0) 2281 CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = -nn_hls, data_ni = jpi, data_jbegin = -nn_hls, data_nj = jpj) 2446 2282 CALL iom_set_domain_attr("gznl", lonvalue = real(zlon, dp), & 2447 & latvalue = real(RESHAPE(plat( nldi:nlei, nldj:nlej),(/ ni*nj/)),dp))2448 CALL iom_set_zoom_domain_attr("ptr", ibegin=ix-1, jbegin=0, ni=1, nj= jpjglo)2283 & latvalue = real(RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp)) 2284 CALL iom_set_zoom_domain_attr("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=Nj0glo) 2449 2285 ! 2450 2286 CALL iom_update_file_name('ptr') … … 2523 2359 ! Equatorial section (attributs: jbegin, ni, name_suffix) 2524 2360 CALL dom_ngb( 0.0_wp, 0.0_wp, ix, iy, cl1 ) 2525 CALL iom_set_zoom_domain_attr('Eq'//cl1, ibegin=0, jbegin=iy-1, ni= jpiglo, nj=1 )2361 CALL iom_set_zoom_domain_attr('Eq'//cl1, ibegin=0, jbegin=iy-1, ni=Ni0glo, nj=1 ) 2526 2362 CALL iom_get_file_attr ('Eq'//cl1, name_suffix = clsuff ) 2527 2363 CALL iom_set_file_attr ('Eq'//cl1, name_suffix = TRIM(clsuff)//'_Eq')
Note: See TracChangeset
for help on using the changeset viewer.
