Changeset 6434 for branches/2016/dev_r6409_SIMPLIF_2_usrdef
- Timestamp:
- 2016-04-06T17:51:49+02:00 (8 years ago)
- Location:
- branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90
r6422 r6434 297 297 ELSE 298 298 IF(lwp) WRITE(numout,*) ' ln_read_cfg CALL user_defined module' 299 CALL usr_def_hgr() 300 !SF CALL usr_def_hgr( nbench , jp_cfg , & 301 !SF & ff, & 302 !SF & glamt , glamu , glamv , glamf , & 303 !SF & gphit , gphiu , gphiv , gphif , & 304 !SF & e1t , e1u , e1v , e1f , & 305 !SF & e2t , e2u , e2v , e2f , & 306 !SF & e1e2t , e1e2u , e1e2v , e1e2f , & 307 !SF & e2_e1u , e1_e2v ) 308 ! 299 CALL usr_def_hgr( nbench , jp_cfg , & 300 & ff, & 301 & glamt , glamu , glamv , glamf , & 302 & gphit , gphiu , gphiv , gphif , & 303 & e1t , e1u , e1v , e1f , & 304 & e2t , e2u , e2v , e2f , & 305 & e1e2u , e1e2v , e2_e1u , e1_e2v ) 309 306 ! 310 307 ENDIF … … 402 399 END IF 403 400 ! 404 CASE ( 5 ) ! beta-plane and rotated domain (gyre configuration)405 !406 zbeta = 2. * omega * COS( rad * ppgphi0 ) / ra ! beta at latitude ppgphi0407 zphi0 = 15._wp ! latitude of the first row F-points408 zf0 = 2. * omega * SIN( rad * zphi0 ) ! compute f0 1st point south409 !410 iff = 0411 CALL hgr_read( ie1e2u_v, iff )412 ff(:,:) = ( zf0 + zbeta * ABS( gphif(:,:) - zphi0 ) * rad * ra ) ! f = f0 +beta* y ( y=0 at south)413 !414 IF(lwp) THEN415 WRITE(numout,*)416 WRITE(numout,*) ' Beta-plane and rotated domain : '417 WRITE(numout,*) ' Coriolis parameter varies in this processor from ', ff(nldi,nldj),' to ', ff(nldi,nlej)418 ENDIF419 !420 IF( lk_mpp ) THEN421 zminff=ff(nldi,nldj)422 zmaxff=ff(nldi,nlej)423 CALL mpp_min( zminff ) ! min over the global domain424 CALL mpp_max( zmaxff ) ! max over the global domain425 IF(lwp) WRITE(numout,*) ' Coriolis parameter varies globally from ', zminff,' to ', zmaxff426 END IF427 !428 401 END SELECT 429 402 -
branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/usrdef.F90
r6422 r6434 8 8 9 9 !!---------------------------------------------------------------------- 10 !! usr_def_hgr : initialize the horizontal mesh10 !! usr_def_hgr : compute the horizontal mesh 11 11 !! usr_def_ini : initial state 12 !! usr_def_sbc : initialize the surface bounday conditions12 !! usr_def_sbc : compute the surface bounday conditions 13 13 !! usr_def_xxx : initialize the xxx 14 14 !!---------------------------------------------------------------------- 15 !SF first attempt to define a user_defined_module16 !SF with of NEMO's routines17 !18 !SF USE dom_oce ! ocean space and time domain19 !SF USE par_oce ! ocean space and time domain20 !SF USE phycst ! physical constants21 !SF USE mppini ! shared/distributed memory setting (mpp_init routine)22 !SF USE in_out_manager ! I/O manager23 !SF USE lib_mpp ! MPP library24 !SF USE timing ! Timing25 15 USE step_oce ! module used in the ocean time stepping module (step.F90) 16 USE mppini ! shared/distributed memory setting (mpp_init routine) 17 USE phycst ! physical constants 26 18 IMPLICIT NONE 27 19 PRIVATE … … 37 29 CONTAINS 38 30 39 SUBROUTINE usr_def_hgr() 40 !SF without USE : pass all inputs and outputs 41 !SF SUBROUTINE usr_def_hgr( nbench, jp_cfg, pff, & 42 !SF & pglamt, pglamu, pglamv, pglamf, & 43 !SF & pgphit, pgphiu, pgphiv, pgphif, & 44 !SF & pe1t , pe1u , pe1v , pe1f , & 45 !SF & pe2t , pe2u , pe2v , pe2f , & 46 !SF & pe1e2t, pe1e2u, pe1e2v, pe1e2f, & 47 !SF & pe2_e1u , pe1_e2v ) 31 SUBROUTINE usr_def_hgr( nbench, jp_cfg, pff, & 32 & pglamt, pglamu, pglamv , pglamf, & 33 & pgphit, pgphiu, pgphiv , pgphif, & 34 & pe1t , pe1u , pe1v , pe1f , & 35 & pe2t , pe2u , pe2v , pe2f , & 36 & pe1e2u, pe1e2v, pe2_e1u, pe1_e2v ) 48 37 !!---------------------------------------------------------------------- 49 38 !! *** ROUTINE usr_def_hgr *** 50 39 !! 51 !! ** Purpose : Compute the geographical position (in degre) of the52 !! model grid-points, 40 !! ** Purpose : compute the geographical position (in degre) of the 41 !! model grid-points, the horizontal scale factors (in meters) and 53 42 !! the Coriolis factor (in s-1). 54 43 !! 55 !! ** Method : The geographical position of the model grid-points is44 !! ** Method : the geographical position of the model grid-points is 56 45 !! defined from analytical functions, fslam and fsphi, the deriva- 57 46 !! tives of which gives the horizontal scale factors e1,e2. … … 59 48 !! the two horizontal directions (fse1 and fse2), the model grid- 60 49 !! point position and scale factors are given by: 61 !! t-point:50 !! t-point: 62 51 !! glamt(i,j) = fslam(i ,j ) e1t(i,j) = fse1(i ,j ) 63 52 !! gphit(i,j) = fsphi(i ,j ) e2t(i,j) = fse2(i ,j ) 64 !! u-point:53 !! u-point: 65 54 !! glamu(i,j) = fslam(i+1/2,j ) e1u(i,j) = fse1(i+1/2,j ) 66 55 !! gphiu(i,j) = fsphi(i+1/2,j ) e2u(i,j) = fse2(i+1/2,j ) 67 !! v-point:56 !! v-point: 68 57 !! glamv(i,j) = fslam(i ,j+1/2) e1v(i,j) = fse1(i ,j+1/2) 69 58 !! gphiv(i,j) = fsphi(i ,j+1/2) e2v(i,j) = fse2(i ,j+1/2) 70 !! 59 !! f-point: 71 60 !! glamf(i,j) = fslam(i+1/2,j+1/2) e1f(i,j) = fse1(i+1/2,j+1/2) 72 61 !! gphif(i,j) = fsphi(i+1/2,j+1/2) e2f(i,j) = fse2(i+1/2,j+1/2) … … 77 66 !! + dj(fsphi) **2 )(i,j) 78 67 !! 79 !! 80 !! 81 !! 82 !! 68 !! The coriolis factor is given at z-point by: 69 !! ff = 2.*omega*sin(gphif) (in s-1) 70 !! 71 !! This routine is given as an example, it must be modified 83 72 !! following the user s desiderata. nevertheless, the output as 84 73 !! well as the way to compute the model grid-point position and … … 100 89 !! Madec, Imbard, 1996, Clim. Dyn. 101 90 !!---------------------------------------------------------------------- 102 !SF all varibales needed without using "USE" 103 !SF !!---------------------------------------------------------------------- 104 !SF INTEGER , INTENT(in ) :: nbench, jp_cfg ! parameter of namelist for benchmark, and dimension of GYRE 105 !SF REAL(wp), DIMENSION(:,:), INTENT( out) :: pff ! coriolis factor at f-point 106 !SF REAL(wp), DIMENSION(:,:), INTENT( out) :: pglamt, pglamu, pglamv, pglamf ! longitude outputs 107 !SF REAL(wp), DIMENSION(:,:), INTENT( out) :: pgphit, pgphiu, pgphiv, pgphif ! latitude outputs 108 !SF REAL(wp), DIMENSION(:,:), INTENT( out) :: pe1t, pe1u, pe1v, pe1f ! horizontal scale factors 109 !SF REAL(wp), DIMENSION(:,:), INTENT( out) :: pe2t, pe2u, pe2v, pe2f ! horizontal scale factors 110 !SF REAL(wp), DIMENSION(:,:), INTENT( out) :: pe1e2t, pe1e2u, pe1e2v, pe1e2f ! horizontal scale factors 111 !SF REAL(wp), DIMENSION(:,:), INTENT( out) :: pe2_e1u, pe1_e2v ! horizontal scale factors 112 !SF !!---------------------------------------------------------------------- 91 INTEGER , INTENT(in ) :: nbench, jp_cfg ! parameter of namelist for benchmark, and dimension of GYRE 92 REAL(wp), DIMENSION(:,:), INTENT( out) :: pff ! coriolis factor at f-point 93 REAL(wp), DIMENSION(:,:), INTENT( out) :: pglamt, pglamu, pglamv, pglamf ! longitude outputs 94 REAL(wp), DIMENSION(:,:), INTENT( out) :: pgphit, pgphiu, pgphiv, pgphif ! latitude outputs 95 REAL(wp), DIMENSION(:,:), INTENT( out) :: pe1t, pe1u, pe1v, pe1f ! horizontal scale factors 96 REAL(wp), DIMENSION(:,:), INTENT( out) :: pe2t, pe2u, pe2v, pe2f ! horizontal scale factors 97 REAL(wp), DIMENSION(:,:), INTENT( out) :: pe1e2u , pe1e2v ! horizontal scale factors 98 REAL(wp), DIMENSION(:,:), INTENT( out) :: pe2_e1u, pe1_e2v ! horizontal scale factors 99 !!---------------------------------------------------------------------- 113 100 INTEGER :: ji, jj ! dummy loop indices 114 101 INTEGER :: ii0, ii1, ij0, ij1, iff ! temporary integers … … 156 143 !glamt(i,j) longitude at T-point 157 144 !gphit(i,j) latitude at T-point 158 glamt(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha159 gphit(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha145 pglamt(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha 146 pgphit(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha 160 147 ! 161 148 !glamu(i,j) longitude at U-point 162 149 !gphiu(i,j) latitude at U-point 163 glamu(ji,jj) = glam0 + zim1 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha164 gphiu(ji,jj) = gphi0 - zim1 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha150 pglamu(ji,jj) = glam0 + zim1 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha 151 pgphiu(ji,jj) = gphi0 - zim1 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha 165 152 ! 166 153 !glamv(i,j) longitude at V-point 167 154 !gphiv(i,j) latitude at V-point 168 glamv(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm1 * ze1deg * zsin_alpha169 gphiv(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm1 * ze1deg * zcos_alpha155 pglamv(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm1 * ze1deg * zsin_alpha 156 pgphiv(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm1 * ze1deg * zcos_alpha 170 157 !glamf(i,j) longitude at F-point 171 158 !gphif(i,j) latitude at F-point 172 glamf(ji,jj) = glam0 + zim1 * ze1deg * zcos_alpha + zjm1 * ze1deg * zsin_alpha173 gphif(ji,jj) = gphi0 - zim1 * ze1deg * zsin_alpha + zjm1 * ze1deg * zcos_alpha159 pglamf(ji,jj) = glam0 + zim1 * ze1deg * zcos_alpha + zjm1 * ze1deg * zsin_alpha 160 pgphif(ji,jj) = gphi0 - zim1 * ze1deg * zsin_alpha + zjm1 * ze1deg * zcos_alpha 174 161 END DO 175 162 END DO … … 177 164 ! Horizontal scale factors (in meters) 178 165 ! ====== 179 e1t(:,:) = ze1 ;e2t(:,:) = ze1180 e1u(:,:) = ze1 ;e2u(:,:) = ze1181 e1v(:,:) = ze1 ;e2v(:,:) = ze1182 e1f(:,:) = ze1 ;e2f(:,:) = ze1183 ! 184 e1e2u (:,:) = e1u(:,:) *e2u(:,:)185 e1e2v (:,:) = e1v(:,:) *e2v(:,:)186 ! 187 e2_e1u(:,:) = e2u(:,:) /e1u(:,:)188 e1_e2v(:,:) = e1v(:,:) /e2v(:,:)166 pe1t(:,:) = ze1 ; pe2t(:,:) = ze1 167 pe1u(:,:) = ze1 ; pe2u(:,:) = ze1 168 pe1v(:,:) = ze1 ; pe2v(:,:) = ze1 169 pe1f(:,:) = ze1 ; pe2f(:,:) = ze1 170 ! 171 pe1e2u (:,:) = pe1u(:,:) * pe2u(:,:) 172 pe1e2v (:,:) = pe1v(:,:) * pe2v(:,:) 173 ! 174 pe2_e1u(:,:) = pe2u(:,:) / pe1u(:,:) 175 pe1_e2v(:,:) = pe1v(:,:) / pe2v(:,:) 189 176 190 177 IF( lwp .AND. nn_print >=1 .AND. .NOT.ln_rstart ) THEN ! Control print : Grid informations (if not restart) … … 192 179 WRITE(numout,*) ' longitude and e1 scale factors' 193 180 WRITE(numout,*) ' ------------------------------' 194 WRITE(numout,9300) ( ji, glamt(ji,1),glamu(ji,1), &195 glamv(ji,1),glamf(ji,1), &196 e1t(ji,1),e1u(ji,1), &197 e1v(ji,1),e1f(ji,1), ji = 1, jpi,10)181 WRITE(numout,9300) ( ji, pglamt(ji,1), pglamu(ji,1), & 182 pglamv(ji,1), pglamf(ji,1), & 183 pe1t(ji,1), pe1u(ji,1), & 184 pe1v(ji,1), pe1f(ji,1), ji = 1, jpi,10) 198 185 9300 FORMAT( 1x, i4, f8.2,1x, f8.2,1x, f8.2,1x, f8.2, 1x, & 199 186 f19.10, 1x, f19.10, 1x, f19.10, 1x, f19.10 ) … … 202 189 WRITE(numout,*) ' latitude and e2 scale factors' 203 190 WRITE(numout,*) ' -----------------------------' 204 WRITE(numout,9300) ( jj, gphit(1,jj),gphiu(1,jj), &205 & gphiv(1,jj),gphif(1,jj), &206 & e2t (1,jj),e2u (1,jj), &207 & e2v (1,jj),e2f (1,jj), jj = 1, jpj, 10 )191 WRITE(numout,9300) ( jj, pgphit(1,jj), pgphiu(1,jj), & 192 & pgphiv(1,jj), pgphif(1,jj), & 193 & pe2t (1,jj), pe2u (1,jj), & 194 & pe2v (1,jj), pe2f (1,jj), jj = 1, jpj, 10 ) 208 195 ENDIF 209 196 … … 214 201 ! beta-plane and rotated domain (gyre configuration) 215 202 ! 216 !SF old zbeta = 2. * omega * COS( rad * ppgphi0 ) / ra ! beta at latitude ppgphi0203 !SF old ppsphi0: not more necessary?? zbeta = 2. * omega * COS( rad * ppgphi0 ) / ra ! beta at latitude ppgphi0 217 204 zbeta = 2. * omega * COS( rad * gphi0 ) / ra ! beta at latitude gphi0 218 205 zphi0 = 15._wp ! latitude of the first row F-points 219 206 zf0 = 2. * omega * SIN( rad * zphi0 ) ! compute f0 1st point south 220 207 ! 221 ff(:,:) = ( zf0 + zbeta * ABS(gphif(:,:) - zphi0 ) * rad * ra ) ! f = f0 +beta* y ( y=0 at south)208 pff(:,:) = ( zf0 + zbeta * ABS( pgphif(:,:) - zphi0 ) * rad * ra ) ! f = f0 +beta* y ( y=0 at south) 222 209 iff = 1 223 210 ! … … 225 212 WRITE(numout,*) 226 213 WRITE(numout,*) ' Beta-plane and rotated domain : ' 227 WRITE(numout,*) ' Coriolis parameter varies in this processor from ', ff(nldi,nldj),' to ',ff(nldi,nlej)214 WRITE(numout,*) ' Coriolis parameter varies in this processor from ', pff(nldi,nldj),' to ', pff(nldi,nlej) 228 215 ENDIF 229 216 ! 230 217 IF( lk_mpp ) THEN 231 zminff= ff(nldi,nldj)232 zmaxff= ff(nldi,nlej)218 zminff=pff(nldi,nldj) 219 zmaxff=pff(nldi,nlej) 233 220 CALL mpp_min( zminff ) ! min over the global domain 234 221 CALL mpp_max( zmaxff ) ! max over the global domain
Note: See TracChangeset
for help on using the changeset viewer.