- Timestamp:
- 2020-04-23T15:14:45+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
r12745 r12807 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 … … 117 117 REAL(wp), DIMENSION(2,jpkam1) :: za_bnds ! ABL vertical boundaries 118 118 LOGICAL :: ll_tmppatch = .TRUE. !: seb: patch before we remove periodicity 119 INTEGER :: nldi_save, nlei_save !: and close boundaries in output files120 INTEGER :: nldj_save, nlej_save !:119 INTEGER :: Nis0_save, Nie0_save !: and close boundaries in output files 120 INTEGER :: Njs0_save, Nje0_save !: 121 121 LOGICAL :: ll_closedef = .TRUE. 122 122 !!---------------------------------------------------------------------- … … 127 127 ENDIF 128 128 IF ( ll_tmppatch ) THEN 129 nldi_save = nldi ; nlei_save = nlei130 nldj_save = nldj ; nlej_save = nlej131 IF( nimpp == 1 ) nldi= 1132 IF( nimpp + jpi - 1 == jpiglo ) nlei= jpi133 IF( njmpp == 1 ) nldj= 1134 IF( njmpp + jpj - 1 == jpjglo ) nlej= jpj129 Nis0_save = Nis0 ; Nie0_save = Nie0 130 Njs0_save = Njs0 ; Nje0_save = Nje0 131 IF( nimpp == 1 ) Nis0 = 1 132 IF( nimpp + jpi - 1 == jpiglo ) Nie0 = jpi 133 IF( njmpp == 1 ) Njs0 = 1 134 IF( njmpp + jpj - 1 == jpjglo ) Nje0 = jpj 135 135 ENDIF 136 136 IF ( PRESENT(ld_closedef) ) ll_closedef = ld_closedef … … 169 169 ! 170 170 IF( ln_cfmeta ) THEN ! Add additional grid metadata 171 CALL iom_set_domain_attr("grid_T", area = e1e2t( nldi:nlei, nldj:nlej))172 CALL iom_set_domain_attr("grid_U", area = e1e2u( nldi:nlei, nldj:nlej))173 CALL iom_set_domain_attr("grid_V", area = e1e2v( nldi:nlei, nldj:nlej))174 CALL iom_set_domain_attr("grid_W", area = e1e2t( nldi:nlei, nldj:nlej))171 CALL iom_set_domain_attr("grid_T", area = e1e2t(Nis0:Nie0, Njs0:Nje0)) 172 CALL iom_set_domain_attr("grid_U", area = e1e2u(Nis0:Nie0, Njs0:Nje0)) 173 CALL iom_set_domain_attr("grid_V", area = e1e2v(Nis0:Nie0, Njs0:Nje0)) 174 CALL iom_set_domain_attr("grid_W", area = e1e2t(Nis0:Nie0, Njs0:Nje0)) 175 175 CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit ) 176 176 CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu ) … … 192 192 ! 193 193 IF( ln_cfmeta .AND. .NOT. llrst_context) THEN ! Add additional grid metadata 194 CALL iom_set_domain_attr("grid_T", area = e1e2t_crs( nldi:nlei, nldj:nlej))195 CALL iom_set_domain_attr("grid_U", area = e1u_crs(nldi:nlei, nldj:nlej) * e2u_crs(nldi:nlei, nldj:nlej))196 CALL iom_set_domain_attr("grid_V", area = e1v_crs(nldi:nlei, nldj:nlej) * e2v_crs(nldi:nlei, nldj:nlej))197 CALL iom_set_domain_attr("grid_W", area = e1e2t_crs( nldi:nlei, nldj:nlej))194 CALL iom_set_domain_attr("grid_T", area = e1e2t_crs(Nis0:Nie0, Njs0:Nje0)) 195 CALL iom_set_domain_attr("grid_U", area = e1u_crs(Nis0:Nie0, Njs0:Nje0) * e2u_crs(Nis0:Nie0, Njs0:Nje0)) 196 CALL iom_set_domain_attr("grid_V", area = e1v_crs(Nis0:Nie0, Njs0:Nje0) * e2v_crs(Nis0:Nie0, Njs0:Nje0)) 197 CALL iom_set_domain_attr("grid_W", area = e1e2t_crs(Nis0:Nie0, Njs0:Nje0)) 198 198 CALL set_grid_bounds( "T", glamf_crs, gphif_crs, glamt_crs, gphit_crs ) 199 199 CALL set_grid_bounds( "U", glamv_crs, gphiv_crs, glamu_crs, gphiu_crs ) … … 283 283 ! 284 284 IF ( ll_tmppatch ) THEN 285 nldi = nldi_save ; nlei = nlei_save286 nldj = nldj_save ; nlej = nlej_save285 Nis0 = Nis0_save ; Nie0 = Nie0_save 286 Njs0 = Njs0_save ; Nje0 = Nje0_save 287 287 ENDIF 288 288 #endif … … 762 762 ENDIF 763 763 IF( llwrt ) THEN 764 idompar(:,1) = (/ nlei - nldi + 1, nlej - nldj + 1/)765 idompar(:,2) = (/ mig( nldi) , mjg(nldj)/)766 idompar(:,3) = (/ mig( nlei) , mjg(nlej)/)767 idompar(:,4) = (/ 0 , 0/)768 idompar(:,5) = (/ 0 , 0/)764 idompar(:,1) = (/ Ni_0 , Nj_0 /) 765 idompar(:,2) = (/ mig(Nis0), mjg(Njs0) /) 766 idompar(:,3) = (/ mig(Nie0), mjg(Nje0) /) 767 idompar(:,4) = (/ 0 , 0 /) 768 idompar(:,5) = (/ 0 , 0 /) 769 769 ENDIF 770 770 ! Open the NetCDF file … … 976 976 END SUBROUTINE iom_g1d 977 977 978 SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, k start, kcount, ldxios)978 SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount, ldxios) 979 979 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 980 980 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 984 984 CHARACTER(len=1), INTENT(in ) , OPTIONAL :: cd_type ! nature of grid-points (T, U, V, F, W) 985 985 REAL(wp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.): (not) change sign across the north fold 986 INTEGER , INTENT(in ) , OPTIONAL :: kfill ! value of kfillmode in lbc_lbk 986 987 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kstart ! start axis position of the reading 987 988 INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kcount ! number of points in each axis … … 989 990 ! 990 991 IF( kiomid > 0 ) THEN 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 )992 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom, cdvar , pv_r2d = pvar , ktime = ktime, & 993 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 994 & kstart = kstart , kcount = kcount, ldxios=ldxios ) 994 995 ENDIF 995 996 END SUBROUTINE iom_g2d 996 997 997 SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, k start, kcount, ldxios )998 SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount, ldxios ) 998 999 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 999 1000 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 1003 1004 CHARACTER(len=1), INTENT(in ) , OPTIONAL :: cd_type ! nature of grid-points (T, U, V, F, W) 1004 1005 REAL(wp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.) : (not) change sign across the north fold 1006 INTEGER , INTENT(in ) , OPTIONAL :: kfill ! value of kfillmode in lbc_lbk 1005 1007 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kstart ! start axis position of the reading 1006 1008 INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kcount ! number of points in each axis … … 1008 1010 ! 1009 1011 IF( kiomid > 0 ) THEN 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 )1012 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom, cdvar , pv_r3d = pvar , ktime = ktime, & 1013 & cd_type = cd_type, psgn = psgn , kfill = kfill, & 1014 & kstart = kstart , kcount = kcount, ldxios=ldxios ) 1013 1015 ENDIF 1014 1016 END SUBROUTINE iom_g3d 1015 1017 !!---------------------------------------------------------------------- 1016 1018 1017 SUBROUTINE iom_get_123d( kiomid , kdom , cdvar , pv_r1d, pv_r2d, pv_r3d, &1018 & ktime , cd_type, psgn, kstart, kcount, ldxios )1019 SUBROUTINE iom_get_123d( kiomid , kdom, cdvar, pv_r1d, pv_r2d, pv_r3d, ktime , & 1020 & cd_type, psgn, kfill, kstart, kcount, ldxios ) 1019 1021 !!----------------------------------------------------------------------- 1020 1022 !! *** ROUTINE iom_get_123d *** … … 1033 1035 CHARACTER(len=1) , INTENT(in ), OPTIONAL :: cd_type ! nature of grid-points (T, U, V, F, W) 1034 1036 REAL(wp) , INTENT(in ), OPTIONAL :: psgn ! -1.(1.) : (not) change sign across the north fold 1037 INTEGER , INTENT(in ), OPTIONAL :: kfill ! value of kfillmode in lbc_lbk 1035 1038 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kstart ! start position of the reading in each axis 1036 1039 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kcount ! number of points to be read in each axis … … 1158 1161 ENDIF 1159 1162 ELSE ! not a 1D array as pv_r1d requires jpdom_unknown 1160 ! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej1161 IF( idom == jpdom_global ) istart(1:2) = (/ mig( nldi), mjg(nldj)/)1162 icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1/)1163 ! we do not read the overlap and the extra-halos -> from Nis0 to Nie0 and from Njs0 to Nje0 1164 IF( idom == jpdom_global ) istart(1:2) = (/ mig(Nis0)-nn_hls, mjg(Njs0)-nn_hls /) 1165 icnt(1:2) = (/ Ni_0, Nj_0 /) 1163 1166 IF( PRESENT(pv_r3d) ) THEN 1164 1167 IF( idom == jpdom_auto_xy ) THEN … … 1191 1194 ELSE 1192 1195 IF( irankpv == 2 ) THEN 1193 ishape(1:2) = SHAPE(pv_r2d( nldi:nlei,nldj:nlej )) ; ctmp1 = 'd(nldi:nlei,nldj:nlej)'1196 ishape(1:2) = SHAPE(pv_r2d(Nis0:Nie0,Njs0:Nje0 )) ; ctmp1 = 'd(Nis0:Nie0,Njs0:Nje0)' 1194 1197 ENDIF 1195 1198 IF( irankpv == 3 ) THEN 1196 ishape(1:3) = SHAPE(pv_r3d( nldi:nlei,nldj:nlej,:)) ; ctmp1 = 'd(nldi:nlei,nldj:nlej,:)'1199 ishape(1:3) = SHAPE(pv_r3d(Nis0:Nie0,Njs0:Nje0,:)) ; ctmp1 = 'd(Nis0:Nie0,Njs0:Nje0,:)' 1197 1200 ENDIF 1198 1201 ENDIF … … 1209 1212 ! 1210 1213 ! find the right index of the array to be read 1211 IF( idom /= jpdom_unknown ) THEN ; ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej1214 IF( idom /= jpdom_unknown ) THEN ; ix1 = Nis0 ; ix2 = Nie0 ; iy1 = Njs0 ; iy2 = Nje0 1212 1215 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 1213 1216 ENDIF … … 1224 1227 !--- overlap areas and extra hallows (mpp) 1225 1228 IF( PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 1226 CALL lbc_lnk( 'iom', pv_r2d, cl_type, zsgn, kfillmode = jpfillnothing)1229 CALL lbc_lnk( 'iom', pv_r2d, cl_type, zsgn, kfillmode = kfill ) 1227 1230 ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 1228 CALL lbc_lnk( 'iom', pv_r3d, cl_type, zsgn, kfillmode = jpfillnothing)1231 CALL lbc_lnk( 'iom', pv_r3d, cl_type, zsgn, kfillmode = kfill ) 1229 1232 ENDIF 1230 1233 ! … … 1863 1866 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plat 1864 1867 ! 1865 INTEGER :: ni, nj1866 1868 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask 1867 1869 LOGICAL, INTENT(IN) :: ldxios, ldrxios 1868 1870 !!---------------------------------------------------------------------- 1869 1871 ! 1870 ni = nlei-nldi+1 1871 nj = nlej-nldj+1 1872 ! 1873 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) 1874 CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 1872 CALL iom_set_domain_attr("grid_"//cdgrd,ni_glo=jpiglo,nj_glo=jpjglo,ibegin=nimpp+Nis0-2,jbegin=njmpp+Njs0-2,ni=Ni_0,nj=Nj_0) 1873 CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-Nis0, data_ni = jpi, data_jbegin = 1-Njs0, data_nj = jpj) 1875 1874 !don't define lon and lat for restart reading context. 1876 1875 IF ( .NOT.ldrxios ) & 1877 CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon( nldi:nlei, nldj:nlej),(/ ni*nj/)), &1878 & latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj/)))1876 CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)), & 1877 & latvalue = RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /))) 1879 1878 ! 1880 1879 IF ( ln_mskland .AND. (.NOT.ldxios) ) THEN … … 1887 1886 END SELECT 1888 1887 ! 1889 CALL iom_set_domain_attr( "grid_"//cdgrd , mask = RESHAPE(zmask( nldi:nlei,nldj:nlej,1),(/ni*nj/)) /= 0. )1890 CALL iom_set_grid_attr ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask( nldi:nlei,nldj:nlej,:),(/ni,nj,jpk/)) /= 0. )1888 CALL iom_set_domain_attr( "grid_"//cdgrd , mask = RESHAPE(zmask(Nis0:Nie0,Njs0:Nje0,1),(/Ni_0*Nj_0 /)) /= 0. ) 1889 CALL iom_set_grid_attr ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(Nis0:Nie0,Njs0:Nje0,:),(/Ni_0*Nj_0,jpk/)) /= 0. ) 1891 1890 ENDIF 1892 1891 ! … … 1905 1904 REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt ! Lat/lon coord. of the point of cell (i,j) 1906 1905 ! 1907 INTEGER :: ji, jj, jn , ni, nj1906 INTEGER :: ji, jj, jn 1908 1907 INTEGER :: icnr, jcnr ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 1909 1908 ! ! represents the bottom-left corner of cell (i,j) … … 1921 1920 CASE ('V') ; icnr = -1 ; jcnr = 0 1922 1921 END SELECT 1923 !1924 ni = nlei-nldi+1 ! Dimensions of subdomain interior1925 nj = nlej-nldj+11926 1922 ! 1927 1923 z_fld(:,:) = 1._wp … … 1958 1954 IF( (nbondi == 1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN 1959 1955 DO jn = 1, 4 ! (East or jpni = 1), closed E-W 1960 z_bnds(jn, nlci,:,1) = plat_pnt(nlci,:) ; z_bnds(jn,nlci,:,2) = plon_pnt(nlci,:)1956 z_bnds(jn,jpi,:,1) = plat_pnt(jpi,:) ; z_bnds(jn,jpi,:,2) = plon_pnt(jpi,:) 1961 1957 END DO 1962 1958 ENDIF … … 1968 1964 IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio < 3 ) THEN 1969 1965 DO jn = 1, 4 ! (North or jpnj = 1), no north fold 1970 z_bnds(jn,:, nlcj,1) = plat_pnt(:,nlcj) ; z_bnds(jn,:,nlcj,2) = plon_pnt(:,nlcj)1966 z_bnds(jn,:,jpj,1) = plat_pnt(:,jpj) ; z_bnds(jn,:,jpj,2) = plon_pnt(:,jpj) 1971 1967 END DO 1972 1968 ENDIF … … 1991 1987 ENDIF 1992 1988 ! 1993 CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:, nldi:nlei,nldj:nlej,1),(/ 4,ni*nj/)), &1994 & bounds_lon = RESHAPE(z_bnds(:, nldi:nlei,nldj:nlej,2),(/ 4,ni*nj/)), nvertex=4 )1989 CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:,Nis0:Nie0,Njs0:Nje0,1),(/ 4,Ni_0*Nj_0 /)), & 1990 & bounds_lon = RESHAPE(z_bnds(:,Nis0:Nie0,Njs0:Nje0,2),(/ 4,Ni_0*Nj_0 /)), nvertex=4 ) 1995 1991 ! 1996 1992 DEALLOCATE( z_bnds, z_fld, z_rot ) … … 2008 2004 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plat 2009 2005 ! 2010 INTEGER :: ni, nj,ix, iy2006 INTEGER :: ix, iy 2011 2007 REAL(wp), DIMENSION(:), ALLOCATABLE :: zlon 2012 2008 !!---------------------------------------------------------------------- 2013 2009 ! 2014 ni=nlei-nldi+1 ! define zonal mean domain (jpj*jpk)2015 nj=nlej-nldj+12016 2010 ALLOCATE( zlon(ni*nj) ) ; zlon(:) = 0._wp 2017 2011 ! 2018 2012 ! CALL dom_ngb( -168.53, 65.03, ix, iy, 'T' ) ! i-line that passes through Bering Strait: Reference latitude (used in plots) 2019 2013 CALL dom_ngb( 180., 90., ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots) 2020 CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+ nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj)2021 CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1- nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)2014 CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+Nis0-2, jbegin=njmpp+Njs0-2, ni=Ni_0, nj=Nj_0) 2015 CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-Nis0, data_ni = jpi, data_jbegin = 1-Njs0, data_nj = jpj) 2022 2016 CALL iom_set_domain_attr("gznl", lonvalue = zlon, & 2023 & latvalue = RESHAPE(plat( nldi:nlei, nldj:nlej),(/ ni*nj/)))2017 & latvalue = RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /))) 2024 2018 CALL iom_set_zoom_domain_attr("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=jpjglo) 2025 2019 !
Note: See TracChangeset
for help on using the changeset viewer.
