Changeset 6797
- Timestamp:
- 2016-07-08T10:20:50+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90
r6772 r6797 106 106 WRITE(numout,*) ' type of Kz coarsening (0,1,2) nn_crs_kz = ', nn_crs_kz 107 107 WRITE(numout,*) ' wn coarsened or computed using hdivn ln_crs_wn = ', ln_crs_wn 108 109 SELECT CASE ( nn_crs_kz ) 110 CASE ( 0 ) ; WRITE(numout,*) ' coarsene KZ with MEAN(KZ)' 111 CASE ( 1 ) ; WRITE(numout,*) ' coarsene KZ with MIN(KZ)' 112 CASE ( 2 ) ; WRITE(numout,*) ' coarsene KZ with MAX(KZ)' 113 CASE ( 3 ) ; WRITE(numout,*) ' coarsene KZ with MEANLOG(KZ)' 114 CASE ( 4 ) ; WRITE(numout,*) ' coarsene KZ with MEDIANE(KZ)' 115 CASE ( 5 ) ; WRITE(numout,*) ' coarsene KZ with TKE coarsening' 116 END SELECT 108 117 ENDIF 109 118 … … 111 120 rfacty_r = 1. / nn_facty 112 121 113 write(narea+200,*)"crsini0",nstop; call flush(narea+200)114 122 115 123 !--------------------------------------------------------- … … 117 125 !--------------------------------------------------------- 118 126 CALL crs_dom_def 119 write(narea+200,*)"crsini1",nstop; call flush(narea+200)120 127 121 128 !--------------------------------------------------------- … … 128 135 129 136 CALL crs_dom_msk 130 write(narea+200,*)"crsini2",nstop; call flush(narea+200)131 CALL mppsync()132 133 !IF( narea==279 )THEN134 !WRITE(narea+200,*)"tutu1 ",jpi,jpj,nldi,nlei,nldj,nlej135 !DO jj=1,jpj136 ! WRITE(narea+200,*)"tutu2 ",jj,MINVAL(tmask(:,jj,:)),MAXVAL(tmask(:,jj,:))137 !ENDDO138 !ENDIF139 137 140 138 ! 3.b. Get the coordinates … … 142 140 ! Even-numbered reduction factor, center coordinate on U-,V- faces or f-corner. 143 141 ! 144 !IF ( nresty /= 0 .AND. nrestx /= 0 ) THEN145 142 CALL crs_dom_coordinates( gphit, glamt, 'T', gphit_crs, glamt_crs ) 146 143 CALL crs_dom_coordinates( gphiu, glamu, 'U', gphiu_crs, glamu_crs ) 147 144 CALL crs_dom_coordinates( gphiv, glamv, 'V', gphiv_crs, glamv_crs ) 148 145 CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs ) 149 !ELSEIF ( nresty /= 0 .AND. nrestx == 0 ) THEN150 ! CALL crs_dom_coordinates( gphiu, glamu, 'T', gphit_crs, glamt_crs )151 ! CALL crs_dom_coordinates( gphiu, glamu, 'U', gphiu_crs, glamu_crs )152 ! CALL crs_dom_coordinates( gphif, glamf, 'V', gphiv_crs, glamv_crs )153 ! CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs )154 !ELSEIF ( nresty == 0 .AND. nrestx /= 0 ) THEN155 ! CALL crs_dom_coordinates( gphiv, glamv, 'T', gphit_crs, glamt_crs )156 ! CALL crs_dom_coordinates( gphif, glamf, 'U', gphiu_crs, glamu_crs )157 ! CALL crs_dom_coordinates( gphiv, glamv, 'V', gphiv_crs, glamv_crs )158 ! CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs )159 !ELSE160 ! CALL crs_dom_coordinates( gphif, glamf, 'T', gphit_crs, glamt_crs )161 ! CALL crs_dom_coordinates( gphif, glamf, 'U', gphiu_crs, glamu_crs )162 ! CALL crs_dom_coordinates( gphif, glamf, 'V', gphiv_crs, glamv_crs )163 ! CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs )164 !ENDIF165 CALL mppsync()166 167 write(narea+200,*)"crsini3",nstop; call flush(narea+200)168 146 169 147 ! 3.c. Get the horizontal mesh … … 175 153 CALL crs_dom_hgr( e1v, e2v, 'V', e1v_crs, e2v_crs ) 176 154 CALL crs_dom_hgr( e1f, e2f, 'F', e1f_crs, e2f_crs ) 177 178 DO ji=nldi_crs,nlei_crs179 DO jj=nldj_crs,nlej_crs180 IF( e1t_crs(ji,jj)==0._wp .AND. tmask_crs(ji,jj,1) .NE. 0._wp )WRITE(narea+8000-1,*)"e1t_crs=0",ji,jj;CALL FLUSH(narea+8000-1)181 IF( e1u_crs(ji,jj)==0._wp .AND. umask_crs(ji,jj,1) .NE. 0._wp )WRITE(narea+8000-1,*)"e1u_crs=0",ji,jj;CALL FLUSH(narea+8000-1)182 IF( e1v_crs(ji,jj)==0._wp .AND. vmask_crs(ji,jj,1) .NE. 0._wp )WRITE(narea+8000-1,*)"e1v_crs=0",ji,jj;CALL FLUSH(narea+8000-1)183 IF( e1f_crs(ji,jj)==0._wp .AND. fmask_crs(ji,jj,1) .NE. 0._wp )WRITE(narea+8000-1,*)"e1f_crs=0",ji,jj;CALL FLUSH(narea+8000-1)184 IF( e2t_crs(ji,jj)==0._wp .AND. tmask_crs(ji,jj,1) .NE. 0._wp )WRITE(narea+8000-1,*)"e2t_crs=0",ji,jj;CALL FLUSH(narea+8000-1)185 IF( e2u_crs(ji,jj)==0._wp .AND. umask_crs(ji,jj,1) .NE. 0._wp )WRITE(narea+8000-1,*)"e2u_crs=0",ji,jj;CALL FLUSH(narea+8000-1)186 IF( e2v_crs(ji,jj)==0._wp .AND. vmask_crs(ji,jj,1) .NE. 0._wp )WRITE(narea+8000-1,*)"e2v_crs=0",ji,jj;CALL FLUSH(narea+8000-1)187 IF( e2f_crs(ji,jj)==0._wp .AND. fmask_crs(ji,jj,1) .NE. 0._wp )WRITE(narea+8000-1,*)"e2f_crs=0",ji,jj;CALL FLUSH(narea+8000-1)188 ENDDO189 ENDDO190 191 155 192 156 WHERE(e1t_crs == 0._wp) e1t_crs=r_inf … … 199 163 WHERE(e2f_crs == 0._wp) e2f_crs=r_inf 200 164 201 zmin=MINVAL(e1t_crs,mask=(tmask_crs(:,:,1)==1));CALL mpp_min(zmin);zmax=MAXVAL(e1t_crs,mask=(tmask_crs(:,:,1)==1));CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crs e1t_crs ",zmin,zmax202 zmin=MINVAL(e1u_crs,mask=(umask_crs(:,:,1)==1));CALL mpp_min(zmin);zmax=MAXVAL(e1u_crs,mask=(umask_crs(:,:,1)==1));CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crs e1u_crs ",zmin,zmax203 zmin=MINVAL(e1v_crs,mask=(vmask_crs(:,:,1)==1));CALL mpp_min(zmin);zmax=MAXVAL(e1v_crs,mask=(vmask_crs(:,:,1)==1));CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crs e1v_crs ",zmin,zmax204 zmin=MINVAL(e1f_crs,mask=(fmask_crs(:,:,1)==1));CALL mpp_min(zmin);zmax=MAXVAL(e1f_crs,mask=(fmask_crs(:,:,1)==1));CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crs e1f_crs ",zmin,zmax205 zmin=MINVAL(e2t_crs,mask=(tmask_crs(:,:,1)==1));CALL mpp_min(zmin);zmax=MAXVAL(e2t_crs,mask=(tmask_crs(:,:,1)==1));CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crs e2t_crs ",zmin,zmax206 zmin=MINVAL(e2u_crs,mask=(umask_crs(:,:,1)==1));CALL mpp_min(zmin);zmax=MAXVAL(e2u_crs,mask=(umask_crs(:,:,1)==1));CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crs e2u_crs ",zmin,zmax207 zmin=MINVAL(e2v_crs,mask=(vmask_crs(:,:,1)==1));CALL mpp_min(zmin);zmax=MAXVAL(e2v_crs,mask=(vmask_crs(:,:,1)==1));CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crs e2v_crs ",zmin,zmax208 zmin=MINVAL(e2f_crs,mask=(fmask_crs(:,:,1)==1));CALL mpp_min(zmin);zmax=MAXVAL(e2f_crs,mask=(fmask_crs(:,:,1)==1));CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crs e2f_crs ",zmin,zmax209 210 211 165 e1e2t_crs(:,:) = e1t_crs(:,:) * e2t_crs(:,:) 212 166 213 write(narea+200,*)"crsini4",nstop; call flush(narea+200)214 167 215 168 ! 3.c.2 Coriolis factor … … 248 201 CALL crs_dom_sfc( vmask, 'V', e1e3v_crs, e1e3v_msk, p_e1=e1v, p_e3=zfse3v ) 249 202 250 DO ji=nldi_crs,nlei_crs251 DO jj=nldj_crs,nlej_crs252 DO jk=1,jpk253 IF( e1e2w_crs(ji,jj,jk)==0._wp .AND. tmask_crs(ji,jj,jk)==1._wp )WRITE(narea+8000-1,*)"e1e2w_crs=0",ji,jj,jk;CALL FLUSH(narea+8000-1)254 IF( e1e2w_msk(ji,jj,jk)==0._wp .AND. tmask_crs(ji,jj,jk)==1._wp )WRITE(narea+8000-1,*)"e1e2w_msk=0",ji,jj,jk;CALL FLUSH(narea+8000-1)255 IF( e2e3u_crs(ji,jj,jk)==0._wp .AND. umask_crs(ji,jj,jk)==1._wp )WRITE(narea+8000-1,*)"e2e3u_crs=0",ji,jj,jk;CALL FLUSH(narea+8000-1)256 IF( e2e3u_msk(ji,jj,jk)==0._wp .AND. umask_crs(ji,jj,jk)==1._wp )WRITE(narea+8000-1,*)"e2e3u_msk=0",ji,jj,jk;CALL FLUSH(narea+8000-1)257 IF( e1e3v_crs(ji,jj,jk)==0._wp .AND. vmask_crs(ji,jj,jk)==1._wp )WRITE(narea+8000-1,*)"e1e3v_crs=0",ji,jj,jk;CALL FLUSH(narea+8000-1)258 IF( e1e3v_msk(ji,jj,jk)==0._wp .AND. vmask_crs(ji,jj,jk)==1._wp )WRITE(narea+8000-1,*)"e1e3v_msk=0",ji,jj,jk;CALL FLUSH(narea+8000-1)259 ENDDO260 ENDDO261 ENDDO262 write(narea+200,*)"crsini5",nstop; call flush(narea+200)263 264 ! WHERE(e1e2w_crs == 0._wp) e1e2w_crs=r_inf265 ! WHERE(e2e3u_crs == 0._wp) e2e3u_crs=r_inf266 ! WHERE(e1e3v_crs == 0._wp) e1e3v_crs=r_inf267 ! WHERE(e1e2w_msk == 0._wp) e1e2w_msk=r_inf268 ! WHERE(e2e3u_msk == 0._wp) e2e3u_msk=r_inf269 ! WHERE(e1e3v_msk == 0._wp) e1e3v_msk=r_inf270 zmin=MINVAL(e1e2w_crs,mask=(tmask_crs(:,:,:)==1));CALL mpp_min(zmin);zmax=MAXVAL(e1e2w_crs,mask=(tmask_crs(:,:,:)==1));CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crs e1e2w_crs ",zmin,zmax271 zmin=MINVAL(e2e3u_crs,mask=(umask_crs(:,:,:)==1));CALL mpp_min(zmin);zmax=MAXVAL(e2e3u_crs,mask=(umask_crs(:,:,:)==1));CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crs e2e3u_crs ",zmin,zmax272 zmin=MINVAL(e1e3v_crs,mask=(vmask_crs(:,:,:)==1));CALL mpp_min(zmin);zmax=MAXVAL(e1e3v_crs,mask=(vmask_crs(:,:,:)==1));CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crs e1e3v_crs ",zmin,zmax273 zmin=MINVAL(e1e2w_msk,mask=(tmask_crs(:,:,:)==1));CALL mpp_min(zmin);zmax=MAXVAL(e1e2w_msk,mask=(tmask_crs(:,:,:)==1));CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crs e1e2w_msk ",zmin,zmax274 zmin=MINVAL(e2e3u_msk,mask=(umask_crs(:,:,:)==1));CALL mpp_min(zmin);zmax=MAXVAL(e2e3u_msk,mask=(umask_crs(:,:,:)==1));CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crs e2e3u_msk ",zmin,zmax275 zmin=MINVAL(e1e3v_msk,mask=(vmask_crs(:,:,:)==1));CALL mpp_min(zmin);zmax=MAXVAL(e1e3v_msk,mask=(vmask_crs(:,:,:)==1));CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"crs e1e3v_msk ",zmin,zmax276 277 !cbr facsurfu(:,:,:) = umask_crs(:,:,:) * e2e3u_msk(:,:,:) / e2e3u_crs(:,:,:)278 !cbr facsurfv(:,:,:) = vmask_crs(:,:,:) * e1e3v_msk(:,:,:) / e1e3v_crs(:,:,:)279 203 DO jk=1,jpk 280 204 DO ji=1,jpi_crs … … 291 215 ENDDO 292 216 293 DO ji=nldi_crs,nlei_crs294 DO jj=nldj_crs,nlej_crs295 IF( ABS(e2u_crs(ji,jj)) .LE. 1.e-5 )WRITE(narea+8000-1,*)"UNDERFLOW e2u_crs",ji,jj,e2u_crs(ji,jj),umask_crs(ji,jj,1) ; CALL FLUSH(narea+8000-1)296 IF( ABS(e1v_crs(ji,jj)) .LE. 1.e-5 )WRITE(narea+8000-1,*)"UNDERFLOW e1v_crs",ji,jj,e1v_crs(ji,jj),vmask_crs(ji,jj,1) ; CALL FLUSH(narea+8000-1)297 ENDDO298 ENDDO299 300 301 217 ! 3.d.3 Vertical scale factors 302 218 ! 303 zmin=MINVAL(e2u_crs(nldi_crs:nlei_crs,nldj_crs:nlej_crs));zmax=MAXVAL(e2u_crs(nldi_crs:nlei_crs,nldj_crs:nlej_crs));CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"e2u_crs",zmin,zmax;CALL FLUSH(numout)304 zmin=MINVAL(e1v_crs(nldi_crs:nlei_crs,nldj_crs:nlej_crs));zmax=MAXVAL(e1v_crs(nldi_crs:nlei_crs,nldj_crs:nlej_crs));CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"e1v_crs",zmin,zmax;CALL FLUSH(numout)305 zmin=MINVAL(e1e2w_crs(nldi_crs:nlei_crs,nldj_crs:nlej_crs,:));zmax=MAXVAL(e1e2w_crs(nldi_crs:nlei_crs,nldj_crs:nlej_crs,:));CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"e1e2w_crs",zmin,zmax;CALL FLUSH(numout)306 zmin=MINVAL(zfse3u);zmax=MAXVAL(zfse3u);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"zfse3u",zmin,zmax;CALL FLUSH(numout)307 zmin=MINVAL(zfse3v);zmax=MAXVAL(zfse3v);CALL mpp_min(zmin);CALL mpp_max(zmax);IF(lwp)WRITE(numout,*)"zfse3v",zmin,zmax;CALL FLUSH(numout)308 309 219 CALL crs_dom_e3( e1t, e2t, zfse3t, p_sfc_3d_crs=e1e2w_crs, cd_type='T', p_mask=tmask, p_e3_crs=e3t_0_crs, p_e3_max_crs=e3t_max_0_crs) 310 220 CALL crs_dom_e3( e1t, e2t, zfse3w, p_sfc_3d_crs=e1e2w_crs, cd_type='W', p_mask=tmask, p_e3_crs=e3w_0_crs, p_e3_max_crs=e3w_max_0_crs) … … 316 226 WHERE(e3w_max_0_crs == 0._wp) e3w_max_0_crs=r_inf 317 227 318 write(narea+200,*)"crsini6",nstop; call flush(narea+200)319 228 #if defined key_vvl 320 229 e3t_max_n_crs=e3t_max_0_crs … … 336 245 #endif 337 246 338 write(narea+200,*)"crsini7",nstop; call flush(narea+200)339 247 ! Reset 0 to e3t_0 or e3w_0 340 248 DO jk = 1, jpk … … 375 283 #endif 376 284 377 write(narea+200,*)"crsini8",nstop; call flush(narea+200)378 285 379 286 !--------------------------------------------------------- … … 397 304 !CALL dom_grid_glo ! Return to parent grid domain 398 305 399 write(narea+200,*)"crsini9",nstop; call flush(narea+200)400 306 401 307 ! … … 413 319 rhop_crs(:,:,:)=0._wp ; rhd_crs(:,:,:)=0._wp ; rb2_crs(:,:,:)=0._wp 414 320 415 write(narea+200,*)"crsini10",nstop; call flush(narea+200)416 321 417 322 !---------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
