- Timestamp:
- 2020-04-11T15:38:38+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/IOM/iom.F90
r12489 r12738 665 665 666 666 667 SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom,ldstop, ldiof, kdlev )667 SUBROUTINE iom_open( cdname, kiomid, ldwrt, ldstop, ldiof, kdlev ) 668 668 !!--------------------------------------------------------------------- 669 669 !! *** SUBROUTINE iom_open *** … … 674 674 INTEGER , INTENT( out) :: kiomid ! iom identifier of the opened file 675 675 LOGICAL , INTENT(in ), OPTIONAL :: ldwrt ! open in write modeb (default = .FALSE.) 676 INTEGER , INTENT(in ), OPTIONAL :: kdom ! Type of domain to be written (default = jpdom_local_noovlap)677 676 LOGICAL , INTENT(in ), OPTIONAL :: ldstop ! stop if open to read a non-existing file (default = .TRUE.) 678 677 LOGICAL , INTENT(in ), OPTIONAL :: ldiof ! Interp On the Fly, needed for AGRIF (default = .FALSE.) … … 686 685 LOGICAL :: llok ! check the existence 687 686 LOGICAL :: llwrt ! local definition of ldwrt 688 LOGICAL :: llnoov ! local definition to read overlap689 687 LOGICAL :: llstop ! local definition of ldstop 690 688 LOGICAL :: lliof ! local definition of ldiof 691 689 INTEGER :: icnt ! counter for digits in clcpu (max = jpmax_digits) 692 690 INTEGER :: iln, ils ! lengths of character 693 INTEGER :: idom ! type of domain694 691 INTEGER :: istop ! 695 692 INTEGER, DIMENSION(2,5) :: idompar ! domain parameters: … … 725 722 ELSE ; lliof = .FALSE. 726 723 ENDIF 727 ! do we read the overlap728 ! ugly patch SM+JMM+RB to overwrite global definition in some cases729 llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif730 724 ! create the file name by added, if needed, TRIM(Agrif_CFixed()) and TRIM(clsuffix) 731 725 ! ============= … … 768 762 ENDIF 769 763 IF( llwrt ) THEN 770 ! check the domain definition 771 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 772 ! idom = jpdom_local_noovlap ! default definition 773 IF( llnoov ) THEN ; idom = jpdom_local_noovlap ! default definition 774 ELSE ; idom = jpdom_local_full ! default definition 775 ENDIF 776 IF( PRESENT(kdom) ) idom = kdom 777 ! create the domain informations 778 ! ============= 779 SELECT CASE (idom) 780 CASE (jpdom_local_full) 781 idompar(:,1) = (/ jpi , jpj /) 782 idompar(:,2) = (/ nimpp , njmpp /) 783 idompar(:,3) = (/ nimpp + jpi - 1 , njmpp + jpj - 1 /) 784 idompar(:,4) = (/ nldi - 1 , nldj - 1 /) 785 idompar(:,5) = (/ jpi - nlei , jpj - nlej /) 786 CASE (jpdom_local_noextra) 787 idompar(:,1) = (/ nlci , nlcj /) 788 idompar(:,2) = (/ nimpp , njmpp /) 789 idompar(:,3) = (/ nimpp + nlci - 1, njmpp + nlcj - 1 /) 790 idompar(:,4) = (/ nldi - 1 , nldj - 1 /) 791 idompar(:,5) = (/ nlci - nlei , nlcj - nlej /) 792 CASE (jpdom_local_noovlap) 793 idompar(:,1) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 794 idompar(:,2) = (/ nimpp + nldi - 1, njmpp + nldj - 1 /) 795 idompar(:,3) = (/ nimpp + nlei - 1, njmpp + nlej - 1 /) 796 idompar(:,4) = (/ 0 , 0 /) 797 idompar(:,5) = (/ 0 , 0 /) 798 CASE DEFAULT 799 CALL ctl_stop( TRIM(clinfo), 'wrong value of kdom, only jpdom_local* cases are accepted' ) 800 END SELECT 764 idompar(:,1) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 765 idompar(:,2) = (/ nimpp + nldi - 1, njmpp + nldj - 1 /) 766 idompar(:,3) = (/ nimpp + nlei - 1, njmpp + nlej - 1 /) 767 idompar(:,4) = (/ 0 , 0 /) 768 idompar(:,5) = (/ 0 , 0 /) 801 769 ENDIF 802 770 ! Open the NetCDF file … … 991 959 END SUBROUTINE iom_g0d 992 960 993 SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, ldxios )961 SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, ldxios ) 994 962 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 995 963 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 1002 970 ! 1003 971 IF( kiomid > 0 ) THEN 1004 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar, pv_r1d=pvar, &1005 & ktime=ktime, kstart=kstart, kcount=kcount,&1006 &ldxios=ldxios )972 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r1d=pvar, & 973 & ktime=ktime , & 974 & kstart=kstart, kcount=kcount , ldxios=ldxios ) 1007 975 ENDIF 1008 976 END SUBROUTINE iom_g1d 1009 977 1010 SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios) 1011 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1012 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 1013 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 1014 REAL(wp) , INTENT( out), DIMENSION(:,:) :: pvar ! read field 1015 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 1016 INTEGER , INTENT(in ), DIMENSION(2) , OPTIONAL :: kstart ! start axis position of the reading 1017 INTEGER , INTENT(in ), DIMENSION(2) , OPTIONAL :: kcount ! number of points in each axis 1018 LOGICAL , INTENT(in ) , OPTIONAL :: lrowattr ! logical flag telling iom_get to 1019 ! look for and use a file attribute 1020 ! called open_ocean_jstart to set the start 1021 ! value for the 2nd dimension (netcdf only) 1022 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS 978 SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kstart, kcount, ldxios) 979 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 980 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 981 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 982 REAL(wp) , INTENT( out), DIMENSION(:,:) :: pvar ! read field 983 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 984 CHARACTER(len=1), INTENT(in ) , OPTIONAL :: cd_type ! nature of grid-points (T, U, V, F, W) 985 REAL(wp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.): (not) change sign across the north fold 986 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kstart ! start axis position of the reading 987 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kcount ! number of points in each axis 988 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS 1023 989 ! 1024 990 IF( kiomid > 0 ) THEN 1025 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar, pv_r2d=pvar, &1026 & ktime=ktime, kstart=kstart, kcount=kcount,&1027 & lrowattr=lrowattr, ldxios=ldxios)991 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r2d=pvar, & 992 & ktime=ktime , cd_type = cd_type, psgn = psgn, & 993 & kstart=kstart, kcount=kcount , ldxios=ldxios ) 1028 994 ENDIF 1029 995 END SUBROUTINE iom_g2d 1030 996 1031 SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios ) 1032 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1033 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 1034 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 1035 REAL(wp) , INTENT( out), DIMENSION(:,:,:) :: pvar ! read field 1036 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 1037 INTEGER , INTENT(in ), DIMENSION(3) , OPTIONAL :: kstart ! start axis position of the reading 1038 INTEGER , INTENT(in ), DIMENSION(3) , OPTIONAL :: kcount ! number of points in each axis 1039 LOGICAL , INTENT(in ) , OPTIONAL :: lrowattr ! logical flag telling iom_get to 1040 ! look for and use a file attribute 1041 ! called open_ocean_jstart to set the start 1042 ! value for the 2nd dimension (netcdf only) 1043 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS 997 SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kstart, kcount, ldxios ) 998 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 999 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 1000 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 1001 REAL(wp) , INTENT( out), DIMENSION(:,:,:) :: pvar ! read field 1002 INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number 1003 CHARACTER(len=1), INTENT(in ) , OPTIONAL :: cd_type ! nature of grid-points (T, U, V, F, W) 1004 REAL(wp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.) : (not) change sign across the north fold 1005 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kstart ! start axis position of the reading 1006 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kcount ! number of points in each axis 1007 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS 1044 1008 ! 1045 1009 IF( kiomid > 0 ) THEN 1046 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar, pv_r3d=pvar, &1047 & ktime=ktime, kstart=kstart, kcount=kcount,&1048 & lrowattr=lrowattr, ldxios=ldxios)1010 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r3d=pvar, & 1011 & ktime=ktime , cd_type = cd_type, psgn = psgn, & 1012 & kstart=kstart, kcount=kcount , ldxios=ldxios ) 1049 1013 ENDIF 1050 1014 END SUBROUTINE iom_g3d 1051 1015 !!---------------------------------------------------------------------- 1052 1016 1053 SUBROUTINE iom_get_123d( kiomid, kdom , cdvar , & 1054 & pv_r1d, pv_r2d, pv_r3d, & 1055 & ktime , kstart, kcount, & 1056 & lrowattr, ldxios ) 1017 SUBROUTINE iom_get_123d( kiomid, kdom , cdvar , pv_r1d, pv_r2d, pv_r3d, & 1018 & ktime , cd_type, psgn , kstart, kcount, ldxios ) 1057 1019 !!----------------------------------------------------------------------- 1058 1020 !! *** ROUTINE iom_get_123d *** … … 1062 1024 !! ** Method : read ONE record at each CALL 1063 1025 !!----------------------------------------------------------------------- 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(wp), DIMENSION(:) , INTENT( out), OPTIONAL :: pv_r1d ! read field (1D case) 1068 REAL(wp), DIMENSION(:,:) , INTENT( out), OPTIONAL :: pv_r2d ! read field (2D case) 1069 REAL(wp), DIMENSION(:,:,:) , INTENT( out), OPTIONAL :: pv_r3d ! read field (3D case) 1070 INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number 1071 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kstart ! start position of the reading in each axis 1072 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kcount ! number of points to be read in each axis 1073 LOGICAL , INTENT(in ), OPTIONAL :: lrowattr ! logical flag telling iom_get to 1074 ! look for and use a file attribute 1075 ! called open_ocean_jstart to set the start 1076 ! value for the 2nd dimension (netcdf only) 1077 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use XIOS to read restart 1078 ! 1079 LOGICAL :: llxios ! local definition for XIOS read 1080 LOGICAL :: llnoov ! local definition to read overlap 1081 LOGICAL :: luse_jattr ! local definition to read open_ocean_jstart file attribute 1082 INTEGER :: jstartrow ! start point for 2nd dimension optionally set by file attribute 1026 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1027 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read 1028 CHARACTER(len=*) , INTENT(in ) :: cdvar ! Name of the variable 1029 REAL(wp), DIMENSION(:) , INTENT( out), OPTIONAL :: pv_r1d ! read field (1D case) 1030 REAL(wp), DIMENSION(:,:) , INTENT( out), OPTIONAL :: pv_r2d ! read field (2D case) 1031 REAL(wp), DIMENSION(:,:,:) , INTENT( out), OPTIONAL :: pv_r3d ! read field (3D case) 1032 INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number 1033 CHARACTER(len=1) , INTENT(in ), OPTIONAL :: cd_type ! nature of grid-points (T, U, V, F, W) 1034 REAL(wp) , INTENT(in ), OPTIONAL :: psgn ! -1.(1.) : (not) change sign across the north fold 1035 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kstart ! start position of the reading in each axis 1036 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kcount ! number of points to be read in each axis 1037 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use XIOS to read restart 1038 ! 1039 LOGICAL :: llok ! true if ok! 1040 LOGICAL :: llxios ! local definition for XIOS read 1083 1041 INTEGER :: jl ! loop on number of dimension 1084 1042 INTEGER :: idom ! type of domain … … 1097 1055 INTEGER, DIMENSION(jpmax_dims) :: ishape ! size of the dimensions of the variable 1098 1056 REAL(wp) :: zscf, zofs ! sacle_factor and add_offset 1057 REAL(wp) :: zsgn ! local value of psgn 1099 1058 INTEGER :: itmp ! temporary integer 1100 1059 CHARACTER(LEN=256) :: clinfo ! info character 1101 1060 CHARACTER(LEN=256) :: clname ! file name 1102 1061 CHARACTER(LEN=1) :: clrankpv, cldmspc ! 1103 LOGICAL :: ll_depth_spec ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension. 1062 CHARACTER(LEN=1) :: cl_type ! local value of cd_type 1063 LOGICAL :: ll_only3rd ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension. 1104 1064 INTEGER :: inlev ! number of levels for 3D data 1105 1065 REAL(wp) :: gma, gmi … … 1110 1070 ! 1111 1071 llxios = .FALSE. 1112 if(PRESENT(ldxios))llxios = ldxios1113 idvar = iom_varid( kiomid, cdvar )1072 IF( PRESENT(ldxios) ) llxios = ldxios 1073 ! 1114 1074 idom = kdom 1075 istop = nstop 1115 1076 ! 1116 1077 IF(.NOT.llxios) THEN 1117 1078 clname = iom_file(kiomid)%name ! esier to read 1118 1079 clinfo = ' iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar) 1119 ! local definition of the domain ?1120 ! do we read the overlap1121 ! ugly patch SM+JMM+RB to overwrite global definition in some cases1122 llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif1123 1080 ! check kcount and kstart optionals parameters... 1124 IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') 1125 IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 1126 IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND. idom /= jpdom_autoglo_xy ) & 1127 & CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown or kdom = jpdom_autoglo_xy') 1128 1129 luse_jattr = .false. 1130 IF( PRESENT(lrowattr) ) THEN 1131 IF( lrowattr .AND. idom /= jpdom_data ) CALL ctl_stop(trim(clinfo), 'lrowattr present and true needs kdom = jpdom_data') 1132 IF( lrowattr .AND. idom == jpdom_data ) luse_jattr = .true. 1133 ENDIF 1134 1081 IF( PRESENT(kcount) .AND. .NOT. PRESENT(kstart) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') 1082 IF( PRESENT(kstart) .AND. .NOT. PRESENT(kcount) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 1083 IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND. idom /= jpdom_auto_xy ) & 1084 & CALL ctl_stop(TRIM(clinfo), 'kstart present needs idom = jpdom_unknown or idom = jpdom_auto_xy') 1085 ! 1135 1086 ! Search for the variable in the data base (eventually actualize data) 1136 istop = nstop1137 1087 ! 1088 idvar = iom_varid( kiomid, cdvar ) 1138 1089 IF( idvar > 0 ) THEN 1139 ! to write iom_file(kiomid)%dimsz in a shorter way !1140 idimsz(:) = iom_file(kiomid)%dimsz(:, idvar) 1090 ! 1091 idimsz(:) = iom_file(kiomid)%dimsz(:, idvar) ! to write iom_file(kiomid)%dimsz in a shorter way 1141 1092 inbdim = iom_file(kiomid)%ndims(idvar) ! number of dimensions in the file 1142 1093 idmspc = inbdim ! number of spatial dimensions in the file … … 1144 1095 IF( idmspc > 3 ) CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...') 1145 1096 ! 1146 ! update idom definition... 1147 ! Identify the domain in case of jpdom_auto(glo/dta) definition 1148 IF( idom == jpdom_autoglo_xy ) THEN 1149 ll_depth_spec = .TRUE. 1150 idom = jpdom_autoglo 1151 ELSE 1152 ll_depth_spec = .FALSE. 1153 ENDIF 1154 IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN 1155 IF( idom == jpdom_autoglo ) THEN ; idom = jpdom_global 1156 ELSE ; idom = jpdom_data 1157 ENDIF 1097 ! Identify the domain in case of jpdom_auto definition 1098 ll_only3rd = idom == jpdom_auto_xy ! depth is specified if idom == jpdom_auto_xy 1099 IF( idom == jpdom_auto .OR. idom == jpdom_auto_xy ) THEN 1100 idom = jpdom_global ! default 1101 ! else: if the file name finishes with _xxxx.nc with xxxx any number 1158 1102 ind1 = INDEX( clname, '_', back = .TRUE. ) + 1 1159 1103 ind2 = INDEX( clname, '.', back = .TRUE. ) - 1 1160 1104 IF( ind2 > ind1 ) THEN ; IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 ) idom = jpdom_local ; ENDIF 1161 ENDIF1162 ! Identify the domain in case of jpdom_local definition1163 IF( idom == jpdom_local ) THEN1164 IF( idimsz(1) == jpi .AND. idimsz(2) == jpj ) THEN ; idom = jpdom_local_full1165 ELSEIF( idimsz(1) == nlci .AND. idimsz(2) == nlcj ) THEN ; idom = jpdom_local_noextra1166 ELSEIF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN ; idom = jpdom_local_noovlap1167 ELSE ; CALL ctl_stop( trim(clinfo), 'impossible to identify the local domain' )1168 ENDIF1169 1105 ENDIF 1170 1106 ! … … 1179 1115 WRITE(cldmspc , fmt='(i1)') idmspc 1180 1116 ! 1181 !!GS: we consider 2D data as 3D data with vertical dim size = 1 1182 !IF( idmspc < irankpv ) THEN 1183 ! CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension', & 1184 ! & 'it is impossible to read a '//clrankpv//'D array from this file...' ) 1185 !ELSEIF( idmspc == irankpv ) THEN 1186 IF( idmspc == irankpv ) THEN 1117 IF( idmspc < irankpv ) THEN ! it seems we want to read more than we can... 1118 IF( irankpv == 3 .AND. idmspc == 2 ) THEN ! 3D input array from 2D spatial data in the file: 1119 llok = inlev == 1 ! -> 3rd dimension must be equal to 1 1120 ELSEIF( irankpv == 3 .AND. idmspc == 1 ) THEN ! 3D input array from 1D spatial data in the file: 1121 llok = inlev == 1 .AND. SIZE(pv_r3d, 2) == 1 ! -> 2nd and 3rd dimensions must be equal to 1 1122 ELSEIF( irankpv == 2 .AND. idmspc == 2 ) THEN ! 2D input array from 1D spatial data in the file: 1123 llok = SIZE(pv_r2d, 2) == 1 ! -> 2nd dimension must be equal to 1 1124 ELSE 1125 llok = .FALSE. 1126 ENDIF 1127 IF( .NOT. llok ) CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension', & 1128 & '=> cannot read a true '//clrankpv//'D array from this file...' ) 1129 ELSEIF( idmspc == irankpv ) THEN 1187 1130 IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown ) & 1188 1131 & CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' ) 1189 ELSEIF( idmspc > irankpv ) THEN 1132 ELSEIF( idmspc > irankpv ) THEN ! it seems we want to read less than we should... 1190 1133 IF( PRESENT(pv_r2d) .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN 1191 CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...' , &1134 CALL ctl_warn( trim(clinfo), '2D array input but 3 spatial dimensions in the file...' , & 1192 1135 & 'As the size of the z dimension is 1 and as we try to read the first record, ', & 1193 1136 & 'we accept this case, even if there is a possible mix-up between z and time dimension' ) … … 1202 1145 ! definition of istart and icnt 1203 1146 ! 1204 icnt (:) = 1 1205 istart(:) = 1 1147 icnt (:) = 1 ! default definition (simple way to deal with special cases listed above) 1148 istart(:) = 1 ! default definition (simple way to deal with special cases listed above) 1206 1149 istart(idmspc+1) = itime 1207 1208 IF( PRESENT(kstart) .AND. .NOT. ll_ depth_spec) THEN1150 ! 1151 IF( PRESENT(kstart) .AND. .NOT. ll_only3rd ) THEN 1209 1152 istart(1:idmspc) = kstart(1:idmspc) 1210 1153 icnt (1:idmspc) = kcount(1:idmspc) … … 1214 1157 ELSE 1215 1158 IF( .NOT. PRESENT(pv_r1d) ) THEN ! not a 1D array 1216 IF( idom == jpdom_data ) THEN 1217 jstartrow = 1 1218 IF( luse_jattr ) THEN 1219 CALL iom_getatt(kiomid, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found 1220 jstartrow = MAX(1,jstartrow) 1221 ENDIF 1222 istart(1:2) = (/ mig(1), mjg(1) + jstartrow - 1 /) ! icnt(1:2) done below 1223 ELSEIF( idom == jpdom_global ) THEN ; istart(1:2) = (/ nimpp , njmpp /) ! icnt(1:2) done below 1224 ENDIF 1225 ! we do not read the overlap -> we start to read at nldi, nldj 1226 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 1227 ! IF( idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 1228 IF( llnoov .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 1229 ! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej 1230 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 1231 ! icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 1232 IF( llnoov ) THEN ; icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 1233 ELSE ; icnt(1:2) = (/ nlci , nlcj /) 1234 ENDIF 1159 ! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej 1160 IF( idom == jpdom_global ) istart(1:2) = (/ mig(nldi), mjg(nldj) /) 1161 icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 1235 1162 IF( PRESENT(pv_r3d) ) THEN 1236 IF( idom == jpdom_data ) THEN ; icnt(3) = inlev 1237 ELSEIF( ll_depth_spec .AND. PRESENT(kstart) ) THEN ; istart(3) = kstart(3) ; icnt(3) = kcount(3) 1238 ELSE ; icnt(3) = inlev 1163 IF( ll_only3rd .AND. PRESENT(kstart) ) THEN ; istart(3) = kstart(3) ; icnt(3) = kcount(3) 1164 ELSE ; icnt(3) = inlev 1239 1165 ENDIF 1240 1166 ENDIF … … 1242 1168 ENDIF 1243 1169 ENDIF 1244 1170 ! 1245 1171 ! check that istart and icnt can be used with this file 1246 1172 !- … … 1253 1179 ENDIF 1254 1180 END DO 1255 1181 ! 1256 1182 ! check that icnt matches the input array 1257 1183 !- … … 1263 1189 ELSE 1264 1190 IF( irankpv == 2 ) THEN 1265 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 1266 ! ishape(1:2) = SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1 = 'd(nldi:nlei,nldj:nlej)' 1267 IF( llnoov ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1='d(nldi:nlei,nldj:nlej)' 1268 ELSE ; ishape(1:2)=SHAPE(pv_r2d(1 :nlci,1 :nlcj )) ; ctmp1='d(1:nlci,1:nlcj)' 1269 ENDIF 1191 ishape(1:2) = SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1 = 'd(nldi:nlei,nldj:nlej)' 1270 1192 ENDIF 1271 1193 IF( irankpv == 3 ) THEN 1272 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 1273 ! ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1 = 'd(nldi:nlei,nldj:nlej,:)' 1274 IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)' 1275 ELSE ; ishape(1:3)=SHAPE(pv_r3d(1 :nlci,1 :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)' 1276 ENDIF 1194 ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1 = 'd(nldi:nlei,nldj:nlej,:)' 1277 1195 ENDIF 1278 ENDIF 1279 1196 ENDIF 1280 1197 DO jl = 1, irankpv 1281 1198 WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl) … … 1289 1206 IF( idvar > 0 .AND. istop == nstop ) THEN ! no additional errors until this point... 1290 1207 ! 1291 ! find the right index of the array to be read 1292 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 1293 ! IF( idom /= jpdom_unknown ) THEN ; ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej 1294 ! ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 1295 ! ENDIF 1296 IF( llnoov ) THEN 1297 IF( idom /= jpdom_unknown ) THEN ; ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej 1298 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 1299 ENDIF 1300 ELSE 1301 IF( idom /= jpdom_unknown ) THEN ; ix1 = 1 ; ix2 = nlci ; iy1 = 1 ; iy2 = nlcj 1302 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 1303 ENDIF 1208 ! find the right index of the array to be read 1209 IF( idom /= jpdom_unknown ) THEN ; ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej 1210 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 1304 1211 ENDIF 1305 1212 … … 1308 1215 IF( istop == nstop ) THEN ! no additional errors until this point... 1309 1216 IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name) 1310 1217 1218 cl_type = 'T' 1219 IF( PRESENT(cd_type) ) cl_type = cd_type 1220 zsgn = 1._wp 1221 IF( PRESENT(psgn ) ) zsgn = psgn 1311 1222 !--- overlap areas and extra hallows (mpp) 1312 1223 IF( PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 1313 CALL lbc_lnk( 'iom', pv_r2d, 'Z', -999., kfillmode = jpfillnothing )1224 CALL lbc_lnk( 'iom', pv_r2d, cl_type, zsgn, kfillmode = jpfillnothing ) 1314 1225 ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 1315 ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 1316 IF( icnt(3) == inlev ) THEN 1317 CALL lbc_lnk( 'iom', pv_r3d,'Z', -999., kfillmode = jpfillnothing ) 1318 ELSE ! put some arbitrary value (a call to lbc_lnk will be done later...) 1319 DO jj = nlcj+1, jpj ; pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :) ; END DO 1320 DO ji = nlci+1, jpi ; pv_r3d(ji , : , :) = pv_r3d(nlei , : , :) ; END DO 1321 ENDIF 1226 CALL lbc_lnk( 'iom', pv_r3d, cl_type, zsgn, kfillmode = jpfillnothing ) 1322 1227 ENDIF 1323 1228 ! … … 1336 1241 CALL iom_swap( TRIM(crxios_context) ) 1337 1242 IF( PRESENT(pv_r3d) ) THEN 1338 pv_r3d(:, :, :) = 0. 1339 if(lwp) write(numout,*) 'XIOS RST READ (3D): ',trim(cdvar) 1243 IF(lwp) WRITE(numout,*) 'XIOS RST READ (3D): ',TRIM(cdvar) 1340 1244 CALL xios_recv_field( trim(cdvar), pv_r3d) 1341 IF(idom /= jpdom_unknown ) then 1342 CALL lbc_lnk( 'iom', pv_r3d,'Z', -999., kfillmode = jpfillnothing) 1343 ENDIF 1245 IF(idom /= jpdom_unknown ) CALL lbc_lnk( 'iom', pv_r3d,'Z', -999., kfillmode = jpfillnothing) 1344 1246 ELSEIF( PRESENT(pv_r2d) ) THEN 1345 pv_r2d(:, :) = 0. 1346 if(lwp) write(numout,*) 'XIOS RST READ (2D): ', trim(cdvar) 1247 IF(lwp) WRITE(numout,*) 'XIOS RST READ (2D): ', TRIM(cdvar) 1347 1248 CALL xios_recv_field( trim(cdvar), pv_r2d) 1348 IF(idom /= jpdom_unknown ) THEN 1349 CALL lbc_lnk('iom', pv_r2d,'Z',-999., kfillmode = jpfillnothing) 1350 ENDIF 1249 IF(idom /= jpdom_unknown ) CALL lbc_lnk('iom', pv_r2d,'Z',-999., kfillmode = jpfillnothing) 1351 1250 ELSEIF( PRESENT(pv_r1d) ) THEN 1352 pv_r1d(:) = 0. 1353 if(lwp) write(numout,*) 'XIOS RST READ (1D): ', trim(cdvar) 1251 IF(lwp) WRITE(numout,*) 'XIOS RST READ (1D): ', TRIM(cdvar) 1354 1252 CALL xios_recv_field( trim(cdvar), pv_r1d) 1355 1253 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.