New URL for NEMO forge! http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.

obcrst.F90 in trunk/NEMOGCM/NEMO/OPA_SRC/OBC – NEMO

Context Navigation

source: trunk/NEMOGCM/NEMO/OPA_SRC/OBC/obcrst.F90 @ 2841

Last change on this file since 2841 was 2715, checked in by rblod, 13 years ago
First attempt to put dynamic allocation on the trunk
Property svn:keywords set to `Id`
File size: 26.7 KB

Rev	Line
[3]	1	MODULE obcrst
	2	#if defined key_obc
	3	!!=================================================================================
	4	!! * MODULE obcrst *
	5	!! Ocean dynamic : Input/Output files for restart on OBC
	6	!!=================================================================================
	7
	8	!!---------------------------------------------------------------------------------
	9	USE oce ! ocean dynamics and tracers variables
	10	USE dom_oce ! ocean space and time domain variables
	11	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
	12	USE phycst ! physical constants
	13	USE obc_oce ! ocean open boundary conditions
	14	USE lib_mpp ! for mppobc
	15	USE in_out_manager ! I/O manager
	16
	17	IMPLICIT NONE
	18	PRIVATE
	19
[2715]	20	PUBLIC obc_rst_read ! routine called by obc_ini
	21	PUBLIC obc_rst_write ! routine called by step
[3]	22
[2715]	23	!!----------------------------------------------------------------------
[2528]	24	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
[1152]	25	!! $Id$
[2715]	26	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
	27	!!----------------------------------------------------------------------
[3]	28
	29	CONTAINS
	30
[1151]	31	SUBROUTINE obc_rst_write ( kt )
[3]	32	!!--------------------------------------------------------------------------------
[1151]	33	!! * SUBROUTINE obc_rst_write *
[32]	34	!!
	35	!! ** Purpose : Write open boundary restart fields in restart.obc.output file
[3]	36	!!
[32]	37	!! ** Method : restart.obc.output file: Direct access non formatted file.
[3]	38	!! Each nstock time step , save fields which are necessary for restart.
	39	!! - This routine is called if at least the key_obc is defined. It is called
[1151]	40	!! at the same time step than rstwrite.
[3]	41	!! - First record holds OBC parameters nbobc,jpieob,jpiwob,jpjnob,jpjsob and
	42	!! the OBC layout jpjed, jpjef ... for checking purposes.
	43	!! - Following records hold the boundary arrays, in the order east west north
	44	!! south, if they exist.
	45	!! - The writing is realised by vertical slab across the boundary, for bsf, u,
	46	!! v, t, and s boundary arrays. Each record hold a vertical slab.
	47	!! - For mpp, this allows each processor to write only the correct informations
	48	!! it hold. If a processor has no valid informations on boundary, it just
	49	!! skip the writing part (automatically).
	50	!! - Special care is taken for dumping the starting point of a boundary (jpjed,
	51	!! jpjwd, jpind, jpisd) because of the general definition of nje0 njw0,nin0,
	52	!! nis0. This is done to avoid records to be written by 2 adjacent processors.
	53	!!
	54	!! History :
	55	!! ! 97-11 (J.M. Molines) Original code
	56	!! ! 98-11 (J.M. Molines) Bug fix for adjacent processors
	57	!! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) F90
	58	!! ! 03-06 (J.M. Molines) Bug fix for adjacent processors
[32]	59	!! 9.0 ! 04-02 (G. Madec) suppression of numwob, use inum
[3]	60	!!-----------------------------------------------------------------------------------
	61	!! * Arguments
	62	INTEGER, INTENT( in ) :: kt ! ocean time-step index
	63
	64	!! * Local declarations
[623]	65	INTEGER :: ji, jj, jk
	66	INTEGER :: inum ! temporary logical unit
[3]	67	INTEGER :: ibloc, nreclo, jrec, jt, jb
	68	INTEGER :: jfoe, jfow, ifon, ifos
	69	INTEGER :: ino0, it0
	70	!!-----------------------------------------------------------------------------
	71
[32]	72	! 1. Output of restart fields (inum)
[3]	73	! ------------------------------------
	74
	75	IF( ( mod(kt,nstock) == 0 ) .OR. ( kt == nitend ) ) THEN
	76
	77	! 1.0 Initializations
	78	! -------------------
	79	IF(lwp) THEN
	80	WRITE(numout,*) ' '
[1151]	81	WRITE(numout,*) 'obcrst: OBC output for restart with obc_rst_write routine'
[3]	82	WRITE(numout,*) '~~~~~~'
[32]	83	WRITE(numout,*) ' output done in restart.obc.output file at it= ', kt, ' date= ', ndastp
[3]	84	END IF
	85
	86	ino0 = no
	87	it0 = kt
	88	ibloc = 4096*4
	89	nreclo = ibloc( ( ( 26 jpk + 9 )*jpbyt -1)/ibloc + 1)
	90	IF(lwp) WRITE(numout,*) ' '
	91	IF(lwp) WRITE(numout,*) ' OBC restart file opened with nreclo = ',nreclo
	92
	93	! 1.1 Open file
	94	! -------------
[623]	95
[1818]	96	CALL ctl_opn( inum, 'restart.obc.output', 'UNKNOWN', 'UNFORMATTED', 'DIRECT', nreclo, numout, lwp )
[474]	97
[3]	98	! 1.2 Write header
	99	! ----------------
[32]	100	WRITE (inum,REC=1) ino0,it0,nbobc,jpieob,jpiwob,jpjnob,jpjsob, &
[3]	101	jpjed,jpjef,jpjwd,jpjwf,jpind,jpinf,jpisd,jpisf
	102
	103	! 1.3 Write east boundary array if any.
	104	! -------------------------------------
[78]	105	IF( lp_obc_east ) THEN
[3]	106	IF( lfbceast ) THEN
	107	IF(lwp) THEN
	108	WRITE(numout,*) ' '
	109	WRITE(numout,*) ' No restart file for the fixed east OBC'
	110	END IF
	111	ELSE
	112	IF( jpieob /= 0 ) THEN
	113	IF( nje0+njmpp-1 == jpjed .AND. nie1 >= nie0 ) THEN
	114	! ... dump of jpjed if it is on this proc.
	115	jrec = 2
	116	jfoe = jpjed - njmpp + 1
	117	PRINT *,'Narea =',narea,' write jrec =2 east'
[32]	118	WRITE(inum,REC=jrec) &
[3]	119	((( uebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
	120	((( vebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
	121	((( tebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
	122	((( sebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
	123	ENDIF
	124	DO ji = nie0, nie1
	125	DO jj = nje0, nje1
	126	! ... only interested processors go through the following lines
	127	! jfoe = jj + njmpp -1
	128	jfoe = jj
	129	jrec = 2 + jj + njmpp -1 -jpjed
[32]	130	WRITE (inum,REC=jrec) &
[3]	131	((( uebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
	132	((( vebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
	133	((( tebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
	134	((( sebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
	135	END DO
	136	END DO
	137	END IF
	138	END IF
	139	END IF
	140
	141	! 1.4 Write west boundary arrays if any
	142	! -------------------------------------
[78]	143	IF( lp_obc_west ) THEN
[3]	144	IF( lfbcwest ) THEN
	145	IF(lwp) THEN
	146	WRITE(numout,*) ' '
	147	WRITE(numout,*) ' No restart file for the fixed west OBC'
	148	END IF
	149	ELSE
	150	IF( jpiwob /= 0 ) THEN
	151	IF( njw0+njmpp+1 == jpjwd .AND. niw1 >= niw0 ) THEN
	152	! ... dump of jpjwd if it is on this proc.
	153	jrec = 3 + jpjef - jpjed
	154	! jfow = jpjwd
	155	jfow = jpjwd -njmpp + 1
	156	PRINT *,'Narea =',narea,' write jrec =',jrec,' west'
[32]	157	WRITE (inum,REC=jrec) &
[3]	158	((( uwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
	159	((( vwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
	160	((( twbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
	161	((( swbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
	162	END IF
	163	DO ji = niw0, niw1
	164	DO jj = njw0, njw1
	165	! ... only interested processors go through the following lines
	166	! jfow = jj + njmpp -1
	167	jfow = jj
	168	jrec = 3 + jpjef -jpjed + jj + njmpp -1 -jpjwd
[32]	169	WRITE (inum,REC=jrec) &
[3]	170	((( uwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
	171	((( vwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
	172	((( twbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
	173	((( swbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
	174	END DO
	175	END DO
	176	END IF
	177	END IF
	178	END IF
	179
	180	! 1.5 Write north boundary arrays if any
	181	! --------------------------------------
[78]	182	IF( lp_obc_north ) THEN
[3]	183	IF( lfbcnorth ) THEN
	184	IF(lwp) THEN
	185	WRITE(numout,*) ' '
	186	WRITE(numout,*) ' No restart file for the fixed north OBC'
	187	END IF
	188	ELSE
	189	IF( jpjnob /= 0) THEN
	190	IF( nin0+nimpp-1 == jpind .AND. njn1 >= njn0 ) THEN
	191	! ... dump of jpind if it is on this proc.
	192	jrec = 4 + jpjef -jpjed + jpjwf -jpjwd
	193	! ifon = jpind
	194	ifon = jpind -nimpp +1
[32]	195	WRITE (inum,REC=jrec) &
[3]	196	((( unbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
	197	((( vnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
	198	((( tnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
	199	((( snbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
	200	END IF
	201	DO jj = njn0, njn1
	202	DO ji = nin0, nin1
	203	! ... only interested processors go through the following lines
	204	! ifon = ji + nimpp -1
	205	ifon = ji
	206	jrec = 4 + jpjef -jpjed + jpjwf -jpjwd +ji + nimpp -1 -jpind
[32]	207	WRITE (inum,REC=jrec) &
[3]	208	((( unbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
	209	((( vnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
	210	((( tnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
	211	((( snbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
	212	END DO
	213	END DO
	214	END IF
	215	END IF
	216	END IF
	217
	218	! 1.6 Write south boundary arrays if any
	219	! --------------------------------------
[78]	220	IF( lp_obc_south ) THEN
[3]	221	IF( lfbcsouth ) THEN
	222	IF(lwp) THEN
	223	WRITE(numout,*) ' '
	224	WRITE(numout,*) ' No restart file for the fixed south OBC'
	225	WRITE(numout,*) ' '
	226	END IF
	227	ELSE
	228	IF( jpjsob /= 0 ) THEN
	229	IF( nis0+nimpp-1 == jpisd .AND. njs1 >= njs0 ) THEN
	230	! ... dump of jpisd if it is on this proc.
	231	jrec = 5 + jpjef -jpjed + jpjwf -jpjwd +jpinf -jpind
	232	! ifos = jpisd
	233	ifos = jpisd -nimpp + 1
[32]	234	WRITE (inum,REC=jrec) &
[3]	235	((( usbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
	236	((( vsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
	237	((( tsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
	238	((( ssbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
	239	END IF
	240	DO jj = njs0, njs1
	241	DO ji = nis0, nis1
	242	! ... only interested processors go through the following lines
	243	! ifos = ji + nimpp -1
	244	ifos = ji
	245	jrec = 5 + jpjef -jpjed + jpjwf -jpjwd +jpinf -jpind + &
	246	ji + nimpp -1 -jpisd
[32]	247	WRITE (inum,REC=jrec) &
[3]	248	((( usbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
	249	((( vsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
	250	((( tsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
	251	((( ssbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
	252	END DO
	253	END DO
	254	END IF
	255	END IF
	256	END IF
[1151]	257	CLOSE(inum)
[3]	258	END IF
	259
[1151]	260	END SUBROUTINE obc_rst_write
[3]	261
[32]	262
[1151]	263	SUBROUTINE obc_rst_read
[3]	264	!!----------------------------------------------------------------------------
[1151]	265	!! * SUBROUTINE obc_rst_read *
[32]	266	!!
	267	!! ** Purpose : Read files for restart at open boundaries
[3]	268	!!
[32]	269	!! ** Method : Read the previous boundary arrays on unit inum
[3]	270	!! The first record indicates previous characterics
	271	!!
	272	!! History :
	273	!! ! 97-11 (J.M. Molines) Original code
	274	!! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) F90
	275	!!----------------------------------------------------------------------------
	276	!! * Local declarations
[32]	277	INTEGER :: inum = 11 ! temporary logical unit
[2166]	278	INTEGER :: ji,jj,jk
[3]	279	INTEGER :: ino0,it0,nbobc0,jpieob0,jpiwob0,jpjnob0,jpjsob0
	280	INTEGER :: ino1,it1,nbobc1,jpieob1,jpiwob1,jpjnob1,jpjsob1
	281	INTEGER :: ied0,ief0,iwd0,iwf0,ind0,inf0,isd0,isf0
	282	INTEGER :: ied1,ief1,iwd1,iwf1,ind1,inf1,isd1,isf1
	283	INTEGER :: ibloc, nreclo, jrec, jt, jb
	284	INTEGER :: jfoe, jfow, ifon, ifos
	285	!!-----------------------------------------------------------------------------
	286
	287	! 0. Initialisations
	288	! ------------------
	289
	290	ino0 = no
	291	it0 = nit000
	292	nbobc0 = nbobc
	293	jpieob0 = jpieob
	294	jpiwob0 = jpiwob
	295	jpjnob0 = jpjnob
	296	jpjsob0 = jpjsob
	297
	298	ied0 = jpjed
	299	ief0 = jpjef
	300	iwd0 = jpjwd
	301	iwf0 = jpjwf
	302	ind0 = jpind
	303	inf0 = jpinf
	304	isd0 = jpisd
	305	isf0 = jpisf
	306
	307	ibloc = 4096*4
	308	nreclo = ibloc ( ( ( 26 jpk + 9 )*jpbyt -1)/ibloc + 1)
	309
	310	IF(lwp) THEN
[1151]	311	WRITE(numout,*) 'obcrst: beginning of restart with obc_rst_read routine'
[3]	312	WRITE(numout,*) '~~~~~~'
	313	WRITE(numout,*) ' '
	314	WRITE(numout,*) ' The present run :'
	315	WRITE(numout,*) ' number job is : ',no
	316	WRITE(numout,*) ' with the time nit000 : ',nit000
	317	WRITE(numout,*) ' OBC restart file opened with nreclo = ',nreclo
	318	END IF
	319
	320	! 0.1 Open files
	321	! ---------------
[1818]	322	CALL ctl_opn( inum, 'restart.obc', 'UNKNOWN', 'UNFORMATTED', 'DIRECT', nreclo, numout, lwp )
[3]	323
	324	! 1. Read
	325	! -------
	326
	327	! 1.1 First record
	328	! -----------------
[32]	329	READ(inum,REC=1) ino1,it1,nbobc1,jpieob1,jpiwob1,jpjnob1, &
[3]	330	jpjsob1,ied1,ief1,iwd1,iwf1,ind1,inf1,isd1,isf1
	331
	332	IF(lwp) THEN
	333	WRITE(numout,*) ' '
[32]	334	WRITE(numout,*) ' READ inum with number job : ',ino1,' with the time it: ',it1
[3]	335	WRITE(numout,*) ' '
	336	END IF
	337
	338	! 1.2 Control of date
	339	! --------------------
	340	IF( ( it0-it1 ) /= 1 .AND. abs(nrstdt) == 1 ) THEN
[474]	341	CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart', &
	342	& ' ==============', &
[1151]	343	& ' we stop in obc_rst_read routine. Verify the file or rerun with the value', &
[474]	344	& ' 0 for the control of time parameter nrstdt' )
	345
[3]	346	END IF
	347
	348	! 1.3 Control of number of open boundaries
	349	! ----------------------------------------
	350	IF( nbobc1 /= nbobc0 ) THEN
	351	IF(lwp) THEN
	352	WRITE(numout,*) ' ===> W A R N I N G: The number of OBC have changed:'
	353	WRITE(numout,*) ' Last run : ',nbobc0,' obcs'
	354	WRITE(numout,*) ' This run : ',nbobc1,' obcs'
	355	END IF
	356	END IF
	357
	358	! 1.4 Control of which boundary is open
	359	! -------------------------------------
[78]	360	IF( lp_obc_east .AND. ( jpieob1 /= 0 ) ) THEN
[3]	361	IF(lwp) THEN
	362	WRITE(numout,*) ' '
	363	WRITE(numout,*) ' East open boundary'
[1151]	364	IF( jpieob0 /= jpieob1 ) CALL ctl_stop( ' ==>>>> : Problem in obc_rst_read, jpieob have changed' )
[3]	365	END IF
	366	END IF
	367
[78]	368	IF( lp_obc_west .AND. ( jpiwob1 /= 0 ) ) THEN
[3]	369	IF(lwp) THEN
	370	WRITE(numout,*) ' '
	371	WRITE(numout,*) ' West open boundary'
[1151]	372	IF( jpiwob0 /= jpiwob1 ) CALL ctl_stop( ' ==>>>> : Problem in obc_rst_read, jpiwob has changed' )
[3]	373	END IF
	374	END IF
	375
[78]	376	IF( lp_obc_north .AND. ( jpjnob1 /= 0 ) ) THEN
[3]	377	IF(lwp) THEN
	378	WRITE(numout,*) ' '
	379	WRITE(numout,*) ' North open boundary'
[1151]	380	IF( jpjnob0 /= jpjnob1 ) CALL ctl_stop( ' ==>>>> : Problem in obc_rst_read, jpjnob has changed' )
[3]	381	END IF
	382	END IF
	383
[78]	384	IF( lp_obc_south .AND. ( jpjsob1 /= 0 ) ) THEN
[3]	385	IF(lwp) THEN
	386	WRITE(numout,*) ' '
	387	WRITE(numout,*) ' South open boundary'
[1151]	388	IF( jpjsob0 /= jpjsob1) CALL ctl_stop( ' ==>>>> : Problem in obc_rst_read, jpjsob has changed' )
[3]	389	END IF
	390	END IF
	391
	392
	393	! 1.5 Control of the limit of the boundaries
	394	! ------------------------------------------
[78]	395	IF( lp_obc_east .AND. ( jpieob1 /= 0 ) ) THEN
[1151]	396	IF( ied1 /= ied0 ) CALL ctl_stop( ' ==>>>> : Problem in obc_rst_read, jpjed has changed' )
	397	IF( ief1 /= ief0 ) CALL ctl_stop( ' ==>>>> : Problem in obc_rst_read, jpjef has changed' )
[3]	398	END IF
	399
[78]	400	IF( lp_obc_west .AND. ( jpiwob1 /= 0 ) ) THEN
[1151]	401	IF( iwd1 /= iwd0 ) CALL ctl_stop( ' ==>>>> : Problem in obc_rst_read, jpjwd has changed' )
	402	IF( iwf1 /= iwf0 ) CALL ctl_stop( ' ==>>>> : Problem in obc_rst_read, jpjwf has changed' )
[3]	403	END IF
	404
[78]	405	IF( lp_obc_north .AND. ( jpjnob1 /= 0 ) ) THEN
[1151]	406	IF( ind1 /= ind0 ) CALL ctl_stop( ' ==>>>> : Problem in obc_rst_read, jpind has changed' )
	407	IF( inf1 /= inf0 ) CALL ctl_stop( ' ==>>>> : Problem in obc_rst_read, jpinf has changed' )
[3]	408	END IF
	409
[78]	410	IF( lp_obc_south .AND. ( jpjsob1 /= 0 ) ) THEN
[1151]	411	IF( isd1 /= isd0 ) CALL ctl_stop( ' ==>>>> : Problem in obc_rst_read, jpisd has changed' )
	412	IF( isf1 /= isf0 ) CALL ctl_stop( ' ==>>>> : Problem in obc_rst_read, jpisf has changed' )
[3]	413	END IF
	414
	415
	416	! 2. Now read the boundary arrays
	417	! -------------------------------
	418
	419	! 2.1 Read east boundary array if any.
	420	! ------------------------------------
[78]	421	IF( lp_obc_east ) THEN
[3]	422	IF( jpieob1 /= 0) THEN
	423	IF( nje0+njmpp-1 == jpjed .AND. nie1 >= nie0 ) THEN
	424	! ... read of jpjed if it is on this proc.
	425	jrec = 2
	426	! jfoe = jpjed
	427	jfoe = jpjed -njmpp + 1
[32]	428	READ (inum,REC=jrec) &
[3]	429	((( uebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
	430	((( vebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
	431	((( tebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
	432	((( sebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
	433	END IF
	434	DO ji = nie0, nie1
	435	DO jj = nje0, nje1
	436	! ... only interested processors go through the following lines
	437	! jfoe = jj + njmpp -1
	438	jfoe = jj
	439	jrec = 2 + jj + njmpp -1 -jpjed
[32]	440	READ (inum,REC=jrec) &
[3]	441	((( uebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
	442	((( vebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
	443	((( tebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
	444	((( sebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
	445	END DO
	446	END DO
	447
	448	ELSE
	449
[78]	450	! lp_obc_east was not TRUE previously
[3]	451	END IF
	452
	453	END IF
	454
	455	! 2.2 Read west boundary arrays if any.
	456	! -------------------------------------
[78]	457	IF( lp_obc_west ) THEN
[3]	458	IF( jpiwob1 /= 0) THEN
	459	IF( njw0+njmpp-1 == jpjwd .AND. niw1 >= niw0 ) THEN
	460	! ... read of jpjwd if it is on this proc.
	461	jrec = 3 + jpjef - jpjed
	462	! jfow = jpjwd
	463	jfow = jpjwd -njmpp + 1
[32]	464	READ (inum,REC=jrec) &
[3]	465	((( uwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
	466	((( vwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
	467	((( twbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
	468	((( swbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
	469	END IF
	470	DO ji = niw0, niw1
	471	DO jj = njw0, njw1
	472	! ... only interested processors go through the following lines
	473	! jfow = jj + njmpp -1
	474	jfow = jj
	475	jrec = 3 + jpjef -jpjed + jj + njmpp -1 -jpjwd
[32]	476	READ (inum,REC=jrec) &
[3]	477	((( uwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
	478	((( vwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
	479	((( twbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
	480	((( swbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
	481	END DO
	482	END DO
	483
	484	ELSE
	485
[78]	486	! lp_obc_west was not TRUE previously
[3]	487	END IF
	488
	489	END IF
	490
	491	! 2.3 Read north boundary arrays if any.
	492	! --------------------------------------
[78]	493	IF( lp_obc_north ) THEN
[3]	494	IF( jpjnob1 /= 0) THEN
	495	IF( nin0+nimpp-1 == jpind .AND. njn1 >= njn0 ) THEN
	496	! ... read of jpind if it is on this proc.
	497	jrec = 4 + jpjef -jpjed + jpjwf -jpjwd
	498	! ifon = jpind
	499	ifon = jpind -nimpp +1
[32]	500	READ (inum,REC=jrec) &
[3]	501	((( unbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
	502	((( vnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
	503	((( tnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
	504	((( snbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
	505	END IF
	506	DO jj = njn0, njn1
	507	DO ji = nin0, nin1
	508	! ... only interested processors go through the following lines
	509	! ifon = ji + nimpp -1
	510	ifon = ji
	511	jrec = 4 + jpjef -jpjed + jpjwf -jpjwd +ji + nimpp -1 -jpind
[32]	512	READ (inum,REC=jrec) &
[3]	513	((( unbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
	514	((( vnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
	515	((( tnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
	516	((( snbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
	517	END DO
	518	END DO
	519
	520	ELSE
	521
[78]	522	! lp_obc_north was not TRUE previously
[3]	523	END IF
	524
	525	END IF
	526
	527	! 2.4 Read south boundary arrays if any.
	528	! -------------------------------------
[78]	529	IF( lp_obc_south ) THEN
[3]	530	IF( jpjsob1 /= 0) THEN
	531	IF( nis0+nimpp-1 == jpisd .AND. njs1 >= njs0 ) THEN
	532	! ... read of jpisd if it is on this proc.
	533	jrec = 5 + jpjef -jpjed + jpjwf -jpjwd +jpinf -jpind
	534	! ifos = jpisd
	535	ifos = jpisd -nimpp + 1
[32]	536	READ (inum,REC=jrec) &
[3]	537	((( usbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
	538	((( vsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
	539	((( tsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
	540	((( ssbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
	541	END IF
	542	DO jj = njs0, njs1
	543	DO ji = nis0, nis1
	544	! ... only interested processors go through the following lines
	545	! ifos = ji + nimpp -1
	546	ifos = ji
	547	jrec = 5 + jpjef -jpjed + jpjwf -jpjwd +jpinf -jpind + &
	548	ji + nimpp -1 -jpisd
[32]	549	READ (inum,REC=jrec) &
[3]	550	((( usbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
	551	((( vsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
	552	((( tsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
	553	((( ssbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
	554	END DO
	555	END DO
	556	ELSE
[78]	557	! lp_obc_south was not TRUE previously
[3]	558	END IF
	559
	560	END IF
[32]	561	CLOSE(inum)
[3]	562
[32]	563	IF( lk_mpp ) THEN
[78]	564	IF( lp_obc_east ) THEN
[2715]	565	CALL mppobc(uebnd,jpjed,jpjef,jpieob ,jpk33,2,jpj, numout )
	566	CALL mppobc(vebnd,jpjed,jpjef,jpieob+1,jpk33,2,jpj, numout )
	567	CALL mppobc(tebnd,jpjed,jpjef,jpieob+1,jpk22,2,jpj, numout )
	568	CALL mppobc(sebnd,jpjed,jpjef,jpieob+1,jpk22,2,jpj, numout )
[32]	569	ENDIF
[78]	570	IF( lp_obc_west ) THEN
[2715]	571	CALL mppobc(uwbnd,jpjwd,jpjwf,jpiwob,jpk33,2,jpj, numout )
	572	CALL mppobc(vwbnd,jpjwd,jpjwf,jpiwob,jpk33,2,jpj, numout )
	573	CALL mppobc(twbnd,jpjwd,jpjwf,jpiwob,jpk22,2,jpj, numout )
	574	CALL mppobc(swbnd,jpjwd,jpjwf,jpiwob,jpk22,2,jpj, numout )
[32]	575	ENDIF
[78]	576	IF( lp_obc_north ) THEN
[2715]	577	CALL mppobc(unbnd,jpind,jpinf,jpjnob+1,jpk33,1,jpi, numout )
	578	CALL mppobc(vnbnd,jpind,jpinf,jpjnob ,jpk33,1,jpi, numout )
	579	CALL mppobc(tnbnd,jpind,jpinf,jpjnob+1,jpk22,1,jpi, numout )
	580	CALL mppobc(snbnd,jpind,jpinf,jpjnob+1,jpk22,1,jpi, numout )
[32]	581	ENDIF
[78]	582	IF( lp_obc_south ) THEN
[2715]	583	CALL mppobc(usbnd,jpisd,jpisf,jpjsob,jpk33,1,jpi, numout )
	584	CALL mppobc(vsbnd,jpisd,jpisf,jpjsob,jpk33,1,jpi, numout )
	585	CALL mppobc(tsbnd,jpisd,jpisf,jpjsob,jpk22,1,jpi, numout )
	586	CALL mppobc(ssbnd,jpisd,jpisf,jpjsob,jpk22,1,jpi, numout )
[32]	587	ENDIF
	588	ENDIF
[3]	589
[1151]	590	END SUBROUTINE obc_rst_read
[3]	591	#else
	592	!!=================================================================================
	593	!! * MODULE obcrst *
	594	!! Ocean dynamic : Input/Output files for restart on OBC
	595	!!=================================================================================
	596	CONTAINS
[1151]	597	SUBROUTINE obc_rst_write( kt ) ! No Open boundary ==> empty routine
[3]	598	INTEGER,INTENT(in) :: kt
[1151]	599	WRITE(,) 'obc_rst_write: You should not have seen this print! error?', kt
	600	END SUBROUTINE obc_rst_write
	601	SUBROUTINE obc_rst_read ! No Open boundary ==> empty routine
	602	END SUBROUTINE obc_rst_read
[3]	603	#endif
	604
	605	!!=================================================================================
	606	END MODULE obcrst

Note: See TracBrowser for help on using the repository browser.

Download in other formats: