MODULE obcini !!====================================================================== !! *** MODULE obcini *** !! OBC initial state : Open boundary initial state !!====================================================================== !! History : 8.0 ! 97-07 (J.M. Molines, G. Madec) Original code !! NEMO 1.0 ! 02-11 (C. Talandier, A-M. Treguier) Free surface, F90 !! 2.0 ! 05-11 (V. Garnier) Surface pressure gradient organization !!---------------------------------------------------------------------- #if defined key_obc !!---------------------------------------------------------------------- !! 'key_obc' Open Boundary Conditions !!---------------------------------------------------------------------- !! obc_init : initialization for the open boundary condition !!---------------------------------------------------------------------- USE oce ! ocean dynamics and tracers variables USE dom_oce ! ocean space and time domain variables USE lbclnk ! ocean lateral boundary conditions (or mpp link) USE phycst ! physical constants USE obc_oce ! ocean open boundary conditions USE lib_mpp ! for mpp_sum USE in_out_manager ! I/O units USE dynspg_oce ! flag lk_dynspg_flt IMPLICIT NONE PRIVATE PUBLIC obc_init ! routine called by opa.F90 !! * Substitutions # include "obc_vectopt_loop_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/OPA 9.0 , LOCEAN-IPSL (2005) !! $Id$ !! software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE obc_init !!---------------------------------------------------------------------- !! *** ROUTINE obc_init *** !! !! ** Purpose : Initialization of the dynamics and tracer fields at !! the open boundaries. !! !! ** Method : initialization of open boundary variables !! (u, v) over 3 time step and 3 rows !! (t, s) over 2 time step and 2 rows !! if ln_rstart = .FALSE. : no restart, fields set to zero !! if ln_rstart = .TRUE. : restart, fields are read in a file !! if rdpxxx = 0 then lfbc is set true for this boundary. !! !! ** Input : restart.obc file, restart file for open boundaries !!---------------------------------------------------------------------- USE obcrst, ONLY : obc_rst_read ! Make obc_rst_read routine available !! INTEGER :: ji, jj, istop , inumfbc INTEGER, DIMENSION(4) :: icorner REAL(wp), DIMENSION(2) :: ztestmask !! NAMELIST/namobc/ rn_dpein, rn_dpwin, rn_dpnin, rn_dpsin, & & rn_dpeob, rn_dpwob, rn_dpnob, rn_dpsob, & & rn_volemp, nn_obcdta, cn_obcdta, & & ln_obc_clim, ln_vol_cst, ln_obc_fla !!---------------------------------------------------------------------- REWIND( numnam ) ! Namelist namobc : open boundaries READ ( numnam, namobc ) ! convert DOCTOR namelist name into the OLD names nobc_dta = nn_obcdta cffile = cn_obcdta rdpein = rn_dpein rdpwin = rn_dpwin rdpsin = rn_dpsin rdpnin = rn_dpnin rdpeob = rn_dpeob rdpwob = rn_dpwob rdpsob = rn_dpsob rdpnob = rn_dpnob volemp = rn_volemp ! By security we set rdpxin and rdpxob respectively to 1. and 15. if the corresponding OBC is not activated IF( .NOT.lp_obc_east ) THEN ; rdpein = 1. ; rdpeob = 15. ; END IF IF( .NOT.lp_obc_west ) THEN ; rdpwin = 1. ; rdpwob = 15. ; END IF IF( .NOT.lp_obc_north ) THEN ; rdpnin = 1. ; rdpnob = 15. ; END IF IF( .NOT.lp_obc_south ) THEN ; rdpsin = 1. ; rdpsob = 15. ; END IF ! number of open boudaries and open boundary indicators nbobc = 0 IF( lp_obc_east ) nbobc = nbobc + 1 IF( lp_obc_west ) nbobc = nbobc + 1 IF( lp_obc_north ) nbobc = nbobc + 1 IF( lp_obc_south ) nbobc = nbobc + 1 IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) 'obc_init : initialization of open boundaries' IF(lwp) WRITE(numout,*) '~~~~~~~~' IF(lwp) WRITE(numout,*) ' Number of open boundaries nbobc = ', nbobc IF(lwp) WRITE(numout,*) ! control prints IF(lwp) WRITE(numout,*) ' Namelist namobc' IF(lwp) WRITE(numout,*) ' data in file (=1) or initial state used (=0) nn_obcdta = ', nn_obcdta IF(lwp) WRITE(numout,*) ' climatology (true) or not ln_obc_clim = ', ln_obc_clim IF(lwp) WRITE(numout,*) ' vol_cst (true) or not: ln_vol_cst = ', ln_vol_cst IF(lwp) WRITE(numout,*) ' ' IF(lwp) WRITE(numout,*) ' WARNING ' IF(lwp) WRITE(numout,*) ' Flather"s algorithm is applied with explicit free surface scheme ' IF(lwp) WRITE(numout,*) ' or with free surface time-splitting scheme ' IF(lwp) WRITE(numout,*) ' Nor radiation neither relaxation is allowed with explicit free surface scheme: ' IF(lwp) WRITE(numout,*) ' Radiation and/or relaxation is allowed with free surface time-splitting scheme ' IF(lwp) WRITE(numout,*) ' depending of the choice of rdpXin = rdpXob = 0. for open boundaries ' IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) ' For the filtered free surface case, ' IF(lwp) WRITE(numout,*) ' radiation, relaxation or presciption of data can be applied ' IF(lwp) WRITE(numout,*) IF( lwp.AND.lp_obc_east ) THEN WRITE(numout,*) ' East open boundary :' WRITE(numout,*) ' i index jpieob = ', jpieob WRITE(numout,*) ' damping time scale (days) rn_dpeob = ', rn_dpeob WRITE(numout,*) ' damping time scale (days) rn_dpein = ', rn_dpein ENDIF IF( lwp.AND.lp_obc_west ) THEN WRITE(numout,*) ' West open boundary :' WRITE(numout,*) ' i index jpiwob = ', jpiwob WRITE(numout,*) ' damping time scale (days) rn_dpwob = ', rn_dpwob WRITE(numout,*) ' damping time scale (days) rn_dpwin = ', rn_dpwin ENDIF IF( lwp.AND.lp_obc_north ) THEN WRITE(numout,*) ' North open boundary :' WRITE(numout,*) ' j index jpjnob = ', jpjnob WRITE(numout,*) ' damping time scale (days) rn_dpnob = ', rn_dpnob WRITE(numout,*) ' damping time scale (days) rn_dpnin = ', rn_dpnin ENDIF IF( lwp.AND.lp_obc_south ) THEN WRITE(numout,*) ' South open boundary :' WRITE(numout,*) ' j index jpjsob = ', jpjsob WRITE(numout,*) ' damping time scale (days) rn_dpsob = ', rn_dpsob WRITE(numout,*) ' damping time scale (days) rn_dpsin = ', rn_dpsin WRITE(numout,*) ENDIF IF( nbobc >= 2 .AND. jperio /= 0 ) & & CALL ctl_stop( ' Cyclic or symmetric, and open boundary condition are not compatible' ) ! 1. Initialisation of constants ! ------------------------------ ! ... convert rdp$ob in seconds ! Fixed Bdy flag inbound outbound lfbceast = .FALSE. ; rdpein = rdpein * rday ; rdpeob = rdpeob * rday lfbcwest = .FALSE. ; rdpwin = rdpwin * rday ; rdpwob = rdpwob * rday lfbcnorth = .FALSE. ; rdpnin = rdpnin * rday ; rdpnob = rdpnob * rday lfbcsouth = .FALSE. ; rdpsin = rdpsin * rday ; rdpsob = rdpsob * rday inumfbc = 0 ! ... look for Fixed Boundaries (rdp = 0 ) ! ... When specified, lbcxxx flags are set to TRUE and rdpxxx are set to ! ... a small arbitrary value, (to avoid division by zero further on). ! ... rdpxxx is not used anymore. IF( lp_obc_east ) THEN IF( (rdpein+rdpeob) == 0 ) THEN lfbceast = .TRUE. ; rdpein = 1e-3 ; rdpeob = 1e-3 inumfbc = inumfbc+1 ELSEIF ( (rdpein*rdpeob) == 0 ) THEN CALL ctl_stop( 'obc_init : rn_dpein & rn_dpeob must be both zero or non zero' ) END IF END IF IF( lp_obc_west ) THEN IF( (rdpwin + rdpwob) == 0 ) THEN lfbcwest = .TRUE. ; rdpwin = 1e-3 ; rdpwob = 1e-3 inumfbc = inumfbc+1 ELSEIF ( (rdpwin*rdpwob) == 0 ) THEN CALL ctl_stop( 'obc_init : rn_dpwin & rn_dpwob must be both zero or non zero' ) END IF END IF IF( lp_obc_north ) THEN IF( (rdpnin + rdpnob) == 0 ) THEN lfbcnorth = .TRUE. ; rdpnin = 1e-3 ; rdpnob = 1e-3 inumfbc = inumfbc+1 ELSEIF ( (rdpnin*rdpnob) == 0 ) THEN CALL ctl_stop( 'obc_init : rn_dpnin & rn_dpnob must be both zero or non zero' ) END IF END IF IF( lp_obc_south ) THEN IF( (rdpsin + rdpsob) == 0 ) THEN lfbcsouth = .TRUE. ; rdpsin = 1e-3 ; rdpsob = 1e-3 inumfbc = inumfbc+1 ELSEIF ( (rdpsin*rdpsob) == 0 ) THEN CALL ctl_stop( 'obc_init : rn_dpsin & rn_dpsob must be both zero or non zero' ) END IF END IF ! 2. Clever mpp indices for loops on the open boundaries. ! The loops will be performed only on the processors ! that contain a given open boundary. ! -------------------------------------------------------- IF( lp_obc_east ) THEN ! ... mpp initialization nie0 = max( 1, min(jpieob - nimpp+1, jpi ) ) nie1 = max( 0, min(jpieob - nimpp+1, jpi - 1 ) ) nie0p1 = max( 1, min(jpieob+1 - nimpp+1, jpi ) ) nie1p1 = max( 0, min(jpieob+1 - nimpp+1, jpi - 1 ) ) nie0m1 = max( 1, min(jpieob-1 - nimpp+1, jpi ) ) nie1m1 = max( 0, min(jpieob-1 - nimpp+1, jpi - 1 ) ) nje0 = max( 2, min(jpjed - njmpp+1, jpj ) ) nje1 = max( 0, min(jpjef - njmpp+1, jpj - 1 ) ) nje0p1 = max( 1, min(jpjedp1 - njmpp+1, jpj ) ) nje0m1 = max( 1, min(jpjed - njmpp+1, jpj ) ) nje1m1 = max( 0, min(jpjefm1 - njmpp+1, jpj - 1 ) ) nje1m2 = max( 0, min(jpjefm1-1- njmpp+1, jpj - 1 ) ) IF(lwp) THEN IF( lfbceast ) THEN WRITE(numout,*)' ' WRITE(numout,*)' Specified East Open Boundary' ELSE WRITE(numout,*)' ' WRITE(numout,*)' Radiative East Open Boundary' END IF END IF END IF IF( lp_obc_west ) THEN ! ... mpp initialization niw0 = max( 1, min(jpiwob - nimpp+1, jpi ) ) niw1 = max( 0, min(jpiwob - nimpp+1, jpi - 1 ) ) niw0p1 = max( 1, min(jpiwob+1 - nimpp+1, jpi ) ) niw1p1 = max( 0, min(jpiwob+1 - nimpp+1, jpi - 1 ) ) njw0 = max( 2, min(jpjwd - njmpp+1, jpj ) ) njw1 = max( 0, min(jpjwf - njmpp+1, jpj - 1 ) ) njw0p1 = max( 1, min(jpjwdp1 - njmpp+1, jpj ) ) njw0m1 = max( 1, min(jpjwd - njmpp+1, jpj ) ) njw1m1 = max( 0, min(jpjwfm1 - njmpp+1, jpj - 1 ) ) njw1m2 = max( 0, min(jpjwfm1-1- njmpp+1, jpj - 1 ) ) IF(lwp) THEN IF( lfbcwest ) THEN WRITE(numout,*)' ' WRITE(numout,*)' Specified West Open Boundary' ELSE WRITE(numout,*)' ' WRITE(numout,*)' Radiative West Open Boundary' END IF END IF END IF IF( lp_obc_north ) THEN ! ... mpp initialization nin0 = max( 2, min(jpind - nimpp+1, jpi ) ) nin1 = max( 0, min(jpinf - nimpp+1, jpi - 1 ) ) nin0p1 = max( 1, min(jpindp1 - nimpp+1, jpi ) ) nin0m1 = max( 1, min(jpind - nimpp+1, jpi ) ) nin1m1 = max( 0, min(jpinfm1 - nimpp+1, jpi - 1 ) ) nin1m2 = max( 0, min(jpinfm1-1- nimpp+1, jpi - 1 ) ) njn0 = max( 1, min(jpjnob - njmpp+1, jpj ) ) njn1 = max( 0, min(jpjnob - njmpp+1, jpj - 1 ) ) njn0p1 = max( 1, min(jpjnob+1 - njmpp+1, jpj ) ) njn1p1 = max( 0, min(jpjnob+1 - njmpp+1, jpj - 1 ) ) njn0m1 = max( 1, min(jpjnob-1 - njmpp+1, jpj ) ) njn1m1 = max( 0, min(jpjnob-1 - njmpp+1, jpj - 1 ) ) IF(lwp) THEN IF( lfbcnorth ) THEN WRITE(numout,*)' ' WRITE(numout,*)' Specified North Open Boundary' ELSE WRITE(numout,*)' ' WRITE(numout,*)' Radiative North Open Boundary' END IF END IF END IF IF( lp_obc_south ) THEN ! ... mpp initialization nis0 = max( 2, min(jpisd - nimpp+1, jpi ) ) nis1 = max( 0, min(jpisf - nimpp+1, jpi - 1 ) ) nis0p1 = max( 1, min(jpisdp1 - nimpp+1, jpi ) ) nis0m1 = max( 1, min(jpisd - nimpp+1, jpi ) ) nis1m1 = max( 0, min(jpisfm1 - nimpp+1, jpi - 1 ) ) nis1m2 = max( 0, min(jpisfm1-1- nimpp+1, jpi - 1 ) ) njs0 = max( 1, min(jpjsob - njmpp+1, jpj ) ) njs1 = max( 0, min(jpjsob - njmpp+1, jpj - 1 ) ) njs0p1 = max( 1, min(jpjsob+1 - njmpp+1, jpj ) ) njs1p1 = max( 0, min(jpjsob+1 - njmpp+1, jpj - 1 ) ) IF(lwp) THEN IF( lfbcsouth ) THEN WRITE(numout,*)' ' WRITE(numout,*)' Specified South Open Boundary' ELSE WRITE(numout,*)' ' WRITE(numout,*)' Radiative South Open Boundary' END IF END IF END IF ! 3. mask correction for OBCs ! --------------------------- IF( lp_obc_east ) THEN !... (jpjed,jpjefm1),jpieob bmask(nie0p1:nie1p1,nje0:nje1m1) = 0.e0 ! ... initilization to zero uemsk(:,:) = 0.e0 ; vemsk(:,:) = 0.e0 ; temsk(:,:) = 0.e0 ! ... set 2D mask on East OBC, Vopt DO ji = fs_nie0, fs_nie1 DO jj = nje0, nje1 uemsk(jj,:) = umask(ji, jj,:) * tmask_i(ji,jj) * tmask_i(ji+1,jj) vemsk(jj,:) = vmask(ji+1,jj,:) * tmask_i(ji+1,jj) temsk(jj,:) = tmask(ji+1,jj,:) * tmask_i(ji+1,jj) END DO END DO END IF IF( lp_obc_west ) THEN ! ... (jpjwd,jpjwfm1),jpiwob bmask(niw0:niw1,njw0:njw1m1) = 0.e0 ! ... initilization to zero uwmsk(:,:) = 0.e0 ; vwmsk(:,:) = 0.e0 ; twmsk(:,:) = 0.e0 ! ... set 2D mask on West OBC, Vopt DO ji = fs_niw0, fs_niw1 DO jj = njw0, njw1 uwmsk(jj,:) = umask(ji,jj,:) * tmask_i(ji,jj) * tmask_i(ji+1,jj) vwmsk(jj,:) = vmask(ji,jj,:) * tmask_i(ji,jj) twmsk(jj,:) = tmask(ji,jj,:) * tmask_i(ji,jj) END DO END DO END IF IF( lp_obc_north ) THEN ! ... jpjnob,(jpind,jpisfm1) bmask(nin0:nin1m1,njn0p1:njn1p1) = 0.e0 ! ... initilization to zero unmsk(:,:) = 0.e0 ; vnmsk(:,:) = 0.e0 ; tnmsk(:,:) = 0.e0 ! ... set 2D mask on North OBC, Vopt DO jj = fs_njn0, fs_njn1 DO ji = nin0, nin1 unmsk(ji,:) = umask(ji,jj+1,:) * tmask_i(ji,jj+1) vnmsk(ji,:) = vmask(ji,jj ,:) * tmask_i(ji,jj) * tmask_i(ji,jj+1) tnmsk(ji,:) = tmask(ji,jj+1,:) * tmask_i(ji,jj+1) END DO END DO END IF IF( lp_obc_south ) THEN ! ... jpjsob,(jpisd,jpisfm1) bmask(nis0:nis1m1,njs0:njs1) = 0.e0 ! ... initilization to zero usmsk(:,:) = 0.e0 ; vsmsk(:,:) = 0.e0 ; tsmsk(:,:) = 0.e0 ! ... set 2D mask on South OBC, Vopt DO jj = fs_njs0, fs_njs1 DO ji = nis0, nis1 usmsk(ji,:) = umask(ji,jj,:) * tmask_i(ji,jj) vsmsk(ji,:) = vmask(ji,jj,:) * tmask_i(ji,jj) * tmask_i(ji,jj+1) tsmsk(ji,:) = tmask(ji,jj,:) * tmask_i(ji,jj) END DO END DO END IF IF ( ln_vol_cst .OR. lk_dynspg_flt ) THEN ! ... Initialize obcumask and obcvmask for the Force filtering ! boundary condition in dynspg_flt obcumask(:,:) = umask(:,:,1) obcvmask(:,:) = vmask(:,:,1) ! ... Initialize obctmsk on overlap region and obcs. This mask ! is used in obcvol.F90 to calculate cumulate flux E-P. ! obc Tracer point are outside the domain ( U/V obc points) ==> masked by obctmsk ! - no flux E-P on obcs and overlap region (jpreci = jprecj = 1) obctmsk(:,:) = tmask_i(:,:) IF( lp_obc_east ) THEN ! ... East obc Force filtering mask for the grad D obcumask(nie0 :nie1 ,nje0p1:nje1m1) = 0.e0 obcvmask(nie0p1:nie1p1,nje0p1:nje1m1) = 0.e0 ! ... set to 0 on East OBC obctmsk(nie0p1:nie1p1,nje0:nje1) = 0.e0 END IF IF( lp_obc_west ) THEN ! ... West obc Force filtering mask for the grad D obcumask(niw0:niw1,njw0:njw1) = 0.e0 obcvmask(niw0:niw1,njw0:njw1) = 0.e0 ! ... set to 0 on West OBC obctmsk(niw0:niw1,njw0:njw1) = 0.e0 END IF IF( lp_obc_north ) THEN ! ... North obc Force filtering mask for the grad D obcumask(nin0p1:nin1m1,njn0p1:njn1p1) = 0.e0 obcvmask(nin0p1:nin1m1,njn0 :njn1 ) = 0.e0 ! ... set to 0 on North OBC obctmsk(nin0:nin1,njn0p1:njn1p1) = 0.e0 END IF IF( lp_obc_south ) THEN ! ... South obc Force filtering mask for the grad D obcumask(nis0p1:nis1m1,njs0:njs1) = 0.e0 obcvmask(nis0p1:nis1m1,njs0:njs1) = 0.e0 ! ... set to 0 on South OBC obctmsk(nis0:nis1,njs0:njs1) = 0.e0 END IF ENDIF IF ( ln_vol_cst .OR. lk_dynspg_flt ) THEN ! 3.1 Total lateral surface ! ------------------------- obcsurftot = 0.e0 IF( lp_obc_east ) THEN ! ... East open boundary lateral surface DO ji = nie0, nie1 DO jj = 1, jpj obcsurftot = obcsurftot+hu(ji,jj)*e2u(ji,jj)*uemsk(jj,1) * MAX(obctmsk(ji,jj),obctmsk(ji+1,jj) ) END DO END DO END IF IF( lp_obc_west ) THEN ! ... West open boundary lateral surface DO ji = niw0, niw1 DO jj = 1, jpj obcsurftot = obcsurftot+hu(ji,jj)*e2u(ji,jj)*uwmsk(jj,1) * MAX(obctmsk(ji,jj),obctmsk(ji+1,jj) ) END DO END DO END IF IF( lp_obc_north ) THEN ! ... North open boundary lateral surface DO jj = njn0, njn1 DO ji = 1, jpi obcsurftot = obcsurftot+hv(ji,jj)*e1v(ji,jj)*vnmsk(ji,1) * MAX(obctmsk(ji,jj),obctmsk(ji,jj+1) ) END DO END DO END IF IF( lp_obc_south ) THEN ! ... South open boundary lateral surface DO jj = njs0, njs1 DO ji = 1, jpi obcsurftot = obcsurftot+hv(ji,jj)*e1v(ji,jj)*vsmsk(ji,1) * MAX(obctmsk(ji,jj),obctmsk(ji,jj+1) ) END DO END DO END IF IF( lk_mpp ) CALL mpp_sum( obcsurftot ) ! sum over the global domain ENDIF ! 5. Control print on mask ! The extremities of the open boundaries must be in land ! or else correspond to an "ocean corner" between two open boundaries. ! corner 1 is southwest, 2 is south east, 3 is northeast, 4 is northwest. ! -------------------------------------------------------------------------- icorner(:)=0 ! ... control of the west boundary IF( lp_obc_west ) THEN IF( jpiwob < 2 .OR. jpiwob >= jpiglo-2 ) THEN WRITE(ctmp1,*) ' jpiwob exceed ', jpiglo-2, 'or less than 2' CALL ctl_stop( ctmp1 ) END IF ztestmask(:)=0. DO ji=niw0,niw1 IF( (njw0 + njmpp - 1) == jpjwd ) ztestmask(1)=ztestmask(1)+ tmask(ji,njw0,1) IF( (njw1 + njmpp - 1) == jpjwf ) ztestmask(2)=ztestmask(2)+ tmask(ji,njw1,1) END DO IF( lk_mpp ) CALL mpp_sum( ztestmask, 2 ) ! sum over the global domain IF( ztestmask(1) /= 0. ) icorner(1)=icorner(1)+1 IF( ztestmask(2) /= 0. ) icorner(4)=icorner(4)+1 END IF ! ... control of the east boundary IF( lp_obc_east ) THEN IF( jpieob < 4 .OR. jpieob >= jpiglo ) THEN WRITE(ctmp1,*) ' jpieob exceed ', jpiglo, ' or less than 4' CALL ctl_stop( ctmp1 ) END IF ztestmask(:)=0. DO ji=nie0p1,nie1p1 IF( (nje0 + njmpp - 1) == jpjed ) ztestmask(1)=ztestmask(1)+ tmask(ji,nje0,1) IF( (nje1 + njmpp - 1) == jpjef ) ztestmask(2)=ztestmask(2)+ tmask(ji,nje1,1) END DO IF( lk_mpp ) CALL mpp_sum( ztestmask, 2 ) ! sum over the global domain IF( ztestmask(1) /= 0. ) icorner(2)=icorner(2)+1 IF( ztestmask(2) /= 0. ) icorner(3)=icorner(3)+1 END IF ! ... control of the north boundary IF( lp_obc_north ) THEN IF( jpjnob < 4 .OR. jpjnob >= jpjglo ) THEN WRITE(ctmp1,*) 'jpjnob exceed ', jpjglo, ' or less than 4' CALL ctl_stop( ctmp1 ) END IF ztestmask(:)=0. DO jj=njn0p1,njn1p1 IF( (nin0 + nimpp - 1) == jpind ) ztestmask(1)=ztestmask(1)+ tmask(nin0,jj,1) IF( (nin1 + nimpp - 1) == jpinf ) ztestmask(2)=ztestmask(2)+ tmask(nin1,jj,1) END DO IF( lk_mpp ) CALL mpp_sum( ztestmask, 2 ) ! sum over the global domain IF( ztestmask(1) /= 0. ) icorner(4)=icorner(4)+1 IF( ztestmask(2) /= 0. ) icorner(3)=icorner(3)+1 END IF ! ... control of the south boundary IF( lp_obc_south ) THEN IF( jpjsob < 2 .OR. jpjsob >= jpjglo-2 ) THEN WRITE(ctmp1,*) ' jpjsob exceed ', jpjglo-2, ' or less than 2' CALL ctl_stop( ctmp1 ) END IF ztestmask(:)=0. DO jj=njs0,njs1 IF( (nis0 + nimpp - 1) == jpisd ) ztestmask(1)=ztestmask(1)+ tmask(nis0,jj,1) IF( (nis1 + nimpp - 1) == jpisf ) ztestmask(2)=ztestmask(2)+ tmask(nis1,jj,1) END DO IF( lk_mpp ) CALL mpp_sum( ztestmask, 2 ) ! sum over the global domain IF( ztestmask(1) /= 0. ) icorner(1)=icorner(1)+1 IF( ztestmask(2) /= 0. ) icorner(2)=icorner(2)+1 END IF IF( icorner(1) == 2 ) THEN IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) ' South West ocean corner, two open boudaries' IF(lwp) WRITE(numout,*) ' ========== ' IF(lwp) WRITE(numout,*) IF( jpisd /= jpiwob.OR.jpjsob /= jpjwd ) & & CALL ctl_stop( ' Open boundaries do not fit, we stop' ) ELSE IF( icorner(1) == 1 ) THEN CALL ctl_stop( ' Open boundaries do not fit at SW corner, we stop' ) END IF IF( icorner(2) == 2 ) THEN IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) ' South East ocean corner, two open boudaries' IF(lwp) WRITE(numout,*) ' ========== ' IF(lwp) WRITE(numout,*) IF( jpisf /= jpieob+1.OR.jpjsob /= jpjed ) & & CALL ctl_stop( ' Open boundaries do not fit, we stop' ) ELSE IF( icorner(2) == 1 ) THEN CALL ctl_stop( ' Open boundaries do not fit at SE corner, we stop' ) END IF IF( icorner(3) == 2 ) THEN IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) ' North East ocean corner, two open boudaries' IF(lwp) WRITE(numout,*) ' ========== ' IF(lwp) WRITE(numout,*) IF( jpinf /= jpieob+1 .OR. jpjnob+1 /= jpjef ) & & CALL ctl_stop( ' Open boundaries do not fit, we stop' ) ELSE IF( icorner(3) == 1 ) THEN CALL ctl_stop( ' Open boundaries do not fit at NE corner, we stop' ) END IF IF( icorner(4) == 2 ) THEN IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) ' North West ocean corner, two open boudaries' IF(lwp) WRITE(numout,*) ' ========== ' IF(lwp) WRITE(numout,*) IF( jpind /= jpiwob.OR.jpjnob+1 /= jpjwf ) & & CALL ctl_stop( ' Open boundaries do not fit, we stop' ) ELSE IF( icorner(4) == 1 ) THEN CALL ctl_stop( ' Open boundaries do not fit at NW corner, we stop' ) END IF ! 6. Initialization of open boundary variables (u, v, t, s) ! -------------------------------------------------------------- ! only if at least one boundary is radiative IF ( inumfbc < nbobc .AND. ln_rstart ) THEN ! Restart from restart.obc CALL obc_rst_read ELSE ! ! ... Initialization to zero of radiation arrays. ! ! Those have dimensions of local subdomains uebnd(:,:,:,:) = 0.e0 ; unbnd(:,:,:,:) = 0.e0 vebnd(:,:,:,:) = 0.e0 ; vnbnd(:,:,:,:) = 0.e0 tebnd(:,:,:,:) = 0.e0 ; tnbnd(:,:,:,:) = 0.e0 sebnd(:,:,:,:) = 0.e0 ; snbnd(:,:,:,:) = 0.e0 uwbnd(:,:,:,:) = 0.e0 ; usbnd(:,:,:,:) = 0.e0 vwbnd(:,:,:,:) = 0.e0 ; vsbnd(:,:,:,:) = 0.e0 twbnd(:,:,:,:) = 0.e0 ; tsbnd(:,:,:,:) = 0.e0 swbnd(:,:,:,:) = 0.e0 ; ssbnd(:,:,:,:) = 0.e0 END IF ! 7. Control print ! ----------------------------------------------------------------- ! ... control of the east boundary IF( lp_obc_east ) THEN istop = 0 IF( jpieob < 4 .OR. jpieob >= jpiglo ) THEN IF(lwp) WRITE(numout,cform_err) IF(lwp) WRITE(numout,*) ' jpieob exceed ', jpim1, ' or less than 4' istop = istop + 1 END IF IF( lk_mpp ) THEN ! ... IF( nimpp > jpieob-5) THEN IF(lwp) WRITE(numout,cform_err) IF(lwp) WRITE(numout,*) ' A sub-domain is too close to the East OBC' IF(lwp) WRITE(numout,*) ' nimpp must be < jpieob-5' istop = istop + 1 ENDIF ELSE ! ... stop if e r r o r (s) detected IF( istop /= 0 ) THEN WRITE(ctmp1,*) istop,' obcini : E R R O R (S) detected : stop' CALL ctl_stop( ctmp1 ) ENDIF ENDIF ENDIF ! ... control of the west boundary IF( lp_obc_west ) THEN istop = 0 IF( jpiwob < 2 .OR. jpiwob >= jpiglo ) THEN IF(lwp) WRITE(numout,cform_err) IF(lwp) WRITE(numout,*) ' jpiwob exceed ', jpim1, ' or less than 2' istop = istop + 1 END IF IF( lk_mpp ) THEN IF( (nimpp < jpiwob+5) .AND. (nimpp > 1) ) THEN IF(lwp) WRITE(numout,cform_err) IF(lwp) WRITE(numout,*) ' A sub-domain is too close to the West OBC' IF(lwp) WRITE(numout,*) ' nimpp must be > jpiwob-5 or =1' istop = istop + 1 ENDIF ELSE ! ... stop if e r r o r (s) detected IF( istop /= 0 ) THEN WRITE(ctmp1,*) istop,' obcini : E R R O R (S) detected : stop' CALL ctl_stop( ctmp1 ) ENDIF ENDIF ENDIF ! control of the north boundary IF( lp_obc_north ) THEN istop = 0 IF( jpjnob < 4 .OR. jpjnob >= jpjglo ) THEN IF(lwp) WRITE(numout,cform_err) IF(lwp) WRITE(numout,*) ' jpjnob exceed ', jpjm1,' or less than 4' istop = istop + 1 END IF IF( lk_mpp ) THEN IF( njmpp > jpjnob-5) THEN IF(lwp) WRITE(numout,cform_err) IF(lwp) WRITE(numout,*) ' A sub-domain is too close to the North OBC' IF(lwp) WRITE(numout,*) ' njmpp must be < jpjnob-5' istop = istop + 1 ENDIF ELSE ! ... stop if e r r o r (s) detected IF( istop /= 0 ) THEN WRITE(ctmp1,*) istop,' obcini : E R R O R (S) detected : stop' CALL ctl_stop( ctmp1 ) ENDIF ENDIF ENDIF ! control of the south boundary IF( lp_obc_south ) THEN istop = 0 IF( jpjsob < 2 .OR. jpjsob >= jpjglo ) THEN IF(lwp) WRITE(numout,cform_err) IF(lwp) WRITE(numout,*) ' jpjsob exceed ', jpjm1,' or less than 2' istop = istop + 1 END IF IF( lk_mpp ) THEN IF( (njmpp < jpjsob+5) .AND. (njmpp > 1) ) THEN IF(lwp) WRITE(numout,cform_err) IF(lwp) WRITE(numout,*) ' A sub-domain is too close to the South OBC' IF(lwp) WRITE(numout,*) ' njmpp must be > jpjsob+5 or =1' istop = istop + 1 ENDIF ELSE ! ... stop if e r r o r (s) detected IF( istop /= 0 ) THEN WRITE(ctmp1,*) istop,' obcini : E R R O R (S) detected : stop' CALL ctl_stop( ctmp1 ) ENDIF ENDIF ENDIF END SUBROUTINE obc_init #else !!--------------------------------------------------------------------------------- !! Dummy module NO open boundaries !!--------------------------------------------------------------------------------- CONTAINS SUBROUTINE obc_init ! Dummy routine END SUBROUTINE obc_init #endif !!================================================================================= END MODULE obcini