Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

cpl_oasis3.F90 @ 13190

Last change on this file since 13190 was 10302, checked in by dford, 6 years ago
Merge in revisions 8447:10159 of dev_r5518_GO6_package.
File size: 26.7 KB

Rev	Line
[532]	1	MODULE cpl_oasis3
	2	!!======================================================================
	3	!! * MODULE cpl_oasis *
[4990]	4	!! Coupled O/A : coupled ocean-atmosphere case using OASIS3-MCT
[532]	5	!!=====================================================================
	6	!! History :
[2715]	7	!! 9.0 ! 04-06 (R. Redler, NEC Laboratories Europe, Germany) Original code
	8	!! " " ! 04-11 (R. Redler, NEC Laboratories Europe; N. Keenlyside, W. Park, IFM-GEOMAR, Germany) revision
[532]	9	!! " " ! 04-11 (V. Gayler, MPI M&D) Grid writing
	10	!! " " ! 05-08 (R. Redler, W. Park) frld initialization, paral(2) revision
	11	!! " " ! 05-09 (R. Redler) extended to allow for communication over root only
	12	!! " " ! 06-01 (W. Park) modification of physical part
	13	!! " " ! 06-02 (R. Redler, W. Park) buffer array fix for root exchange
[3294]	14	!! 3.4 ! 11-11 (C. Harris) Changes to allow mutiple category fields
[532]	15	!!----------------------------------------------------------------------
	16	!!----------------------------------------------------------------------
[5407]	17	!! 'key_oasis3' coupled Ocean/Atmosphere via OASIS3-MCT
	18	!! 'key_oa3mct_v3' to be added for OASIS3-MCT version 3
[532]	19	!!----------------------------------------------------------------------
[4990]	20	!! cpl_init : initialization of coupled mode communication
	21	!! cpl_define : definition of grid and fields
	22	!! cpl_snd : snd out fields in coupled mode
	23	!! cpl_rcv : receive fields in coupled mode
	24	!! cpl_finalize : finalize the coupled mode communication
[532]	25	!!----------------------------------------------------------------------
[4990]	26	#if defined key_oasis3
	27	USE mod_oasis ! OASIS3-MCT module
	28	#endif
[1218]	29	USE par_oce ! ocean parameters
[532]	30	USE dom_oce ! ocean space and time domain
	31	USE in_out_manager ! I/O manager
[2715]	32	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
[8280]	33
[532]	34	IMPLICIT NONE
[1218]	35	PRIVATE
[532]	36
[4990]	37	PUBLIC cpl_init
	38	PUBLIC cpl_define
	39	PUBLIC cpl_snd
	40	PUBLIC cpl_rcv
	41	PUBLIC cpl_freq
	42	PUBLIC cpl_finalize
[8280]	43	#if defined key_mpp_mpi
	44	INCLUDE 'mpif.h'
	45	#endif
	46
	47	INTEGER, PARAMETER :: localRoot = 0
	48	LOGICAL :: commRank ! true for ranks doing OASIS communication
	49	#if defined key_cpl_rootexchg
	50	LOGICAL :: rootexchg =.true. ! logical switch
	51	#else
	52	LOGICAL :: rootexchg =.false. ! logical switch
	53	#endif
[2715]	54
	55	INTEGER, PUBLIC :: OASIS_Rcv = 1 !: return code if received field
	56	INTEGER, PUBLIC :: OASIS_idle = 0 !: return code if nothing done by oasis
[4990]	57	INTEGER :: ncomp_id ! id returned by oasis_init_comp
[2715]	58	INTEGER :: nerror ! return error code
[4990]	59	#if ! defined key_oasis3
	60	! OASIS Variables not used. defined only for compilation purpose
	61	INTEGER :: OASIS_Out = -1
	62	INTEGER :: OASIS_REAL = -1
	63	INTEGER :: OASIS_Ok = -1
	64	INTEGER :: OASIS_In = -1
	65	INTEGER :: OASIS_Sent = -1
	66	INTEGER :: OASIS_SentOut = -1
	67	INTEGER :: OASIS_ToRest = -1
	68	INTEGER :: OASIS_ToRestOut = -1
	69	INTEGER :: OASIS_Recvd = -1
	70	INTEGER :: OASIS_RecvOut = -1
	71	INTEGER :: OASIS_FromRest = -1
	72	INTEGER :: OASIS_FromRestOut = -1
	73	#endif
[2715]	74
[5407]	75	INTEGER :: nrcv ! total number of fields received
	76	INTEGER :: nsnd ! total number of fields sent
	77	INTEGER :: ncplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data
	78	INTEGER, PUBLIC, PARAMETER :: nmaxfld=50 ! Maximum number of coupling fields
[4990]	79	INTEGER, PUBLIC, PARAMETER :: nmaxcat=5 ! Maximum number of coupling fields
	80	INTEGER, PUBLIC, PARAMETER :: nmaxcpl=5 ! Maximum number of coupling fields
[1218]	81
[3294]	82	TYPE, PUBLIC :: FLD_CPL !: Type for coupling field information
	83	LOGICAL :: laction ! To be coupled or not
	84	CHARACTER(len = 8) :: clname ! Name of the coupling field
	85	CHARACTER(len = 1) :: clgrid ! Grid type
	86	REAL(wp) :: nsgn ! Control of the sign change
[4990]	87	INTEGER, DIMENSION(nmaxcat,nmaxcpl) :: nid ! Id of the field (no more than 9 categories and 9 extrena models)
[3294]	88	INTEGER :: nct ! Number of categories in field
[4990]	89	INTEGER :: ncplmodel ! Maximum number of models to/from which this variable may be sent/received
[1218]	90	END TYPE FLD_CPL
[532]	91
[2715]	92	TYPE(FLD_CPL), DIMENSION(nmaxfld), PUBLIC :: srcv, ssnd !: Coupling fields
[532]	93
[2715]	94	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: exfld ! Temporary buffer for receiving
[8280]	95	INTEGER, PUBLIC :: localComm
	96
[532]	97	!!----------------------------------------------------------------------
[2528]	98	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
	99	!! $Id$
[2715]	100	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[532]	101	!!----------------------------------------------------------------------
	102	CONTAINS
	103
[5407]	104	SUBROUTINE cpl_init( cd_modname, kl_comm )
[532]	105	!!-------------------------------------------------------------------
[4990]	106	!! * ROUTINE cpl_init *
[532]	107	!!
	108	!! ** Purpose : Initialize coupled mode communication for ocean
	109	!! exchange between AGCM, OGCM and COUPLER. (OASIS3 software)
	110	!!
	111	!! ** Method : OASIS3 MPI communication
	112	!!--------------------------------------------------------------------
[5407]	113	CHARACTER(len = *), INTENT(in) :: cd_modname ! model name as set in namcouple file
	114	INTEGER , INTENT(out) :: kl_comm ! local communicator of the model
[1226]	115	!!--------------------------------------------------------------------
[1218]	116
[1579]	117	! WARNING: No write in numout in this routine
	118	!============================================
	119
[532]	120	!------------------------------------------------------------------
[4990]	121	! 1st Initialize the OASIS system for the application
[532]	122	!------------------------------------------------------------------
[5407]	123	CALL oasis_init_comp ( ncomp_id, TRIM(cd_modname), nerror )
[4990]	124	IF ( nerror /= OASIS_Ok ) &
	125	CALL oasis_abort (ncomp_id, 'cpl_init', 'Failure in oasis_init_comp')
[532]	126
	127	!------------------------------------------------------------------
	128	! 3rd Get an MPI communicator for OPA local communication
	129	!------------------------------------------------------------------
	130
[4990]	131	CALL oasis_get_localcomm ( kl_comm, nerror )
	132	IF ( nerror /= OASIS_Ok ) &
	133	CALL oasis_abort (ncomp_id, 'cpl_init','Failure in oasis_get_localcomm' )
[8280]	134	localComm = kl_comm
[2715]	135	!
[4990]	136	END SUBROUTINE cpl_init
[532]	137
	138
[4990]	139	SUBROUTINE cpl_define( krcv, ksnd, kcplmodel )
[532]	140	!!-------------------------------------------------------------------
[4990]	141	!! * ROUTINE cpl_define *
[532]	142	!!
	143	!! ** Purpose : Define grid and field information for ocean
	144	!! exchange between AGCM, OGCM and COUPLER. (OASIS3 software)
	145	!!
	146	!! ** Method : OASIS3 MPI communication
	147	!!--------------------------------------------------------------------
[2715]	148	INTEGER, INTENT(in) :: krcv, ksnd ! Number of received and sent coupling fields
[4990]	149	INTEGER, INTENT(in) :: kcplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data
[1226]	150	!
[2715]	151	INTEGER :: id_part
	152	INTEGER :: paral(5) ! OASIS3 box partition
[10302]	153	INTEGER :: ishape(4) ! Shape of arrays passed to PSMILe.
	154	! Redundant from OASIS3-MCT vn4.0 onwards but required
	155	! to satisfy interface and for backward compatibility.
	156	INTEGER :: var_nodims(2) ! Number of coupling field dimensions.
	157	! var_nodims(1) is redundant from OASIS3-MCT vn4.0 onwards
	158	! but retained for backward compatibility.
	159	! var_nodims(2) is the number of fields in a bundle
	160	! or 1 for unbundled fields (bundles are not yet catered for
	161	! in NEMO hence we default to 1).
[4990]	162	INTEGER :: ji,jc,jm ! local loop indicees
	163	CHARACTER(LEN=64) :: zclname
	164	CHARACTER(LEN=2) :: cli2
[532]	165	!!--------------------------------------------------------------------
[1218]	166
[532]	167	IF(lwp) WRITE(numout,*)
[4990]	168	IF(lwp) WRITE(numout,*) 'cpl_define : initialization in coupled ocean/atmosphere case'
[532]	169	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~'
	170	IF(lwp) WRITE(numout,*)
	171
[5407]	172	ncplmodel = kcplmodel
[4990]	173	IF( kcplmodel > nmaxcpl ) THEN
[5407]	174	CALL oasis_abort ( ncomp_id, 'cpl_define', 'ncplmodel is larger than nmaxcpl, increase nmaxcpl') ; RETURN
[4990]	175	ENDIF
[5407]	176
	177	nrcv = krcv
	178	IF( nrcv > nmaxfld ) THEN
	179	CALL oasis_abort ( ncomp_id, 'cpl_define', 'nrcv is larger than nmaxfld, increase nmaxfld') ; RETURN
	180	ENDIF
	181
	182	nsnd = ksnd
	183	IF( nsnd > nmaxfld ) THEN
	184	CALL oasis_abort ( ncomp_id, 'cpl_define', 'nsnd is larger than nmaxfld, increase nmaxfld') ; RETURN
	185	ENDIF
	186
[532]	187	!
	188	! ... Define the shape for the area that excludes the halo
	189	! For serial configuration (key_mpp_mpi not being active)
	190	! nl* is set to the global values 1 and jp*glo.
	191	!
[10302]	192	ishape(1) = 1
	193	ishape(2) = nlei-nldi+1
	194	ishape(3) = 1
	195	ishape(4) = nlej-nldj+1
	196
	197
[532]	198	!
	199	! ... Allocate memory for data exchange
	200	!
[1218]	201	ALLOCATE(exfld(nlei-nldi+1, nlej-nldj+1), stat = nerror)
[2715]	202	IF( nerror > 0 ) THEN
[4990]	203	CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating exfld') ; RETURN
[8280]	204	ENDIF
[532]	205	!
[1218]	206	! -----------------------------------------------------------------
	207	! ... Define the partition
	208	! -----------------------------------------------------------------
[8280]	209
[1218]	210	paral(1) = 2 ! box partitioning
	211	paral(2) = jpiglo * (nldj-1+njmpp-1) + (nldi-1+nimpp-1) ! NEMO lower left corner global offset
	212	paral(3) = nlei-nldi+1 ! local extent in i
	213	paral(4) = nlej-nldj+1 ! local extent in j
	214	paral(5) = jpiglo ! global extent in x
	215
	216	IF( ln_ctl ) THEN
	217	WRITE(numout,*) ' multiexchg: paral (1:5)', paral
	218	WRITE(numout,*) ' multiexchg: jpi, jpj =', jpi, jpj
	219	WRITE(numout,*) ' multiexchg: nldi, nlei, nimpp =', nldi, nlei, nimpp
	220	WRITE(numout,*) ' multiexchg: nldj, nlej, njmpp =', nldj, nlej, njmpp
	221	ENDIF
	222
[8280]	223	CALL oasis_def_partition ( id_part, paral, nerror, jpiglo*jpjglo)
[532]	224	!
[1218]	225	! ... Announce send variables.
[532]	226	!
[4990]	227	ssnd(:)%ncplmodel = kcplmodel
	228	!
[1226]	229	DO ji = 1, ksnd
[4990]	230	IF ( ssnd(ji)%laction ) THEN
	231
	232	IF( ssnd(ji)%nct > nmaxcat ) THEN
	233	CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '// &
	234	& TRIM(ssnd(ji)%clname)//' is larger than nmaxcat, increase nmaxcat' )
	235	RETURN
	236	ENDIF
	237
[3294]	238	DO jc = 1, ssnd(ji)%nct
[4990]	239	DO jm = 1, kcplmodel
	240
	241	IF ( ssnd(ji)%nct .GT. 1 ) THEN
	242	WRITE(cli2,'(i2.2)') jc
	243	zclname = TRIM(ssnd(ji)%clname)//'_cat'//cli2
	244	ELSE
	245	zclname = ssnd(ji)%clname
	246	ENDIF
	247	IF ( kcplmodel > 1 ) THEN
	248	WRITE(cli2,'(i2.2)') jm
	249	zclname = 'model'//cli2//'_'//TRIM(zclname)
	250	ENDIF
	251	#if defined key_agrif
	252	IF( agrif_fixed() /= 0 ) THEN
	253	zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname)
	254	END IF
	255	#endif
	256	IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_Out
[10302]	257
	258	!
	259	! ... Set the field dimension and bundle count
	260	var_nodims(1) = 2
	261	var_nodims(2) = 1 ! Modify this value to cater for bundled fields.
	262
	263	CALL oasis_def_var (ssnd(ji)%nid(jc,jm), zclname, id_part , var_nodims, &
[4990]	264	& OASIS_Out , ishape , OASIS_REAL, nerror )
	265	IF ( nerror /= OASIS_Ok ) THEN
	266	WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname)
	267	CALL oasis_abort ( ssnd(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' )
	268	ENDIF
	269	IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple"
	270	IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple"
	271	END DO
[3294]	272	END DO
[1218]	273	ENDIF
[8280]	274	END DO
[1218]	275	!
	276	! ... Announce received variables.
	277	!
[4990]	278	srcv(:)%ncplmodel = kcplmodel
	279	!
[1226]	280	DO ji = 1, krcv
[1218]	281	IF ( srcv(ji)%laction ) THEN
[4990]	282
	283	IF( srcv(ji)%nct > nmaxcat ) THEN
	284	CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '// &
	285	& TRIM(srcv(ji)%clname)//' is larger than nmaxcat, increase nmaxcat' )
	286	RETURN
	287	ENDIF
	288
[3294]	289	DO jc = 1, srcv(ji)%nct
[4990]	290	DO jm = 1, kcplmodel
	291
	292	IF ( srcv(ji)%nct .GT. 1 ) THEN
	293	WRITE(cli2,'(i2.2)') jc
	294	zclname = TRIM(srcv(ji)%clname)//'_cat'//cli2
	295	ELSE
	296	zclname = srcv(ji)%clname
	297	ENDIF
	298	IF ( kcplmodel > 1 ) THEN
	299	WRITE(cli2,'(i2.2)') jm
	300	zclname = 'model'//cli2//'_'//TRIM(zclname)
	301	ENDIF
	302	#if defined key_agrif
	303	IF( agrif_fixed() /= 0 ) THEN
	304	zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname)
	305	END IF
	306	#endif
	307	IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In
[10302]	308
	309	! ... Set the field dimension and bundle count
	310	var_nodims(1) = 2
	311	var_nodims(2) = 1 ! Modify this value to cater for bundled fields.
	312
	313	CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part , var_nodims, &
[4990]	314	& OASIS_In , ishape , OASIS_REAL, nerror )
	315	IF ( nerror /= OASIS_Ok ) THEN
	316	WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname)
	317	CALL oasis_abort ( srcv(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' )
	318	ENDIF
	319	IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple"
	320	IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple"
	321
	322	END DO
[3294]	323	END DO
[1218]	324	ENDIF
	325	END DO
	326
[532]	327	!------------------------------------------------------------------
[1218]	328	! End of definition phase
[532]	329	!------------------------------------------------------------------
[1218]	330
[4990]	331	CALL oasis_enddef(nerror)
	332	IF( nerror /= OASIS_Ok ) CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef')
[2715]	333	!
[4990]	334	END SUBROUTINE cpl_define
[1218]	335
	336
[4990]	337	SUBROUTINE cpl_snd( kid, kstep, pdata, kinfo )
[532]	338	!!---------------------------------------------------------------------
[4990]	339	!! * ROUTINE cpl_snd *
[532]	340	!!
	341	!! ** Purpose : - At each coupling time-step,this routine sends fields
	342	!! like sst or ice cover to the coupler or remote application.
	343	!!----------------------------------------------------------------------
[3294]	344	INTEGER , INTENT(in ) :: kid ! variable index in the array
	345	INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument
	346	INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds
	347	REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pdata
	348	!!
[4990]	349	INTEGER :: jc,jm ! local loop index
[532]	350	!!--------------------------------------------------------------------
	351	!
[1218]	352	! snd data to OASIS3
[532]	353	!
[3294]	354	DO jc = 1, ssnd(kid)%nct
[4990]	355	DO jm = 1, ssnd(kid)%ncplmodel
	356
	357	IF( ssnd(kid)%nid(jc,jm) /= -1 ) THEN
	358	CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo )
	359
	360	IF ( ln_ctl ) THEN
	361	IF ( kinfo == OASIS_Sent .OR. kinfo == OASIS_ToRest .OR. &
	362	& kinfo == OASIS_SentOut .OR. kinfo == OASIS_ToRestOut ) THEN
	363	WRITE(numout,) '***************'
	364	WRITE(numout,*) 'oasis_put: Outgoing ', ssnd(kid)%clname
	365	WRITE(numout,*) 'oasis_put: ivarid ', ssnd(kid)%nid(jc,jm)
	366	WRITE(numout,*) 'oasis_put: kstep ', kstep
	367	WRITE(numout,*) 'oasis_put: info ', kinfo
	368	WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc))
	369	WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc))
	370	WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc))
	371	WRITE(numout,) '***************'
	372	ENDIF
	373	ENDIF
	374
[3294]	375	ENDIF
[4990]	376
	377	ENDDO
[3294]	378	ENDDO
[2715]	379	!
[4990]	380	END SUBROUTINE cpl_snd
[532]	381
	382
[4990]	383	SUBROUTINE cpl_rcv( kid, kstep, pdata, pmask, kinfo )
[532]	384	!!---------------------------------------------------------------------
[4990]	385	!! * ROUTINE cpl_rcv *
[532]	386	!!
	387	!! ** Purpose : - At each coupling time-step,this routine receives fields
	388	!! like stresses and fluxes from the coupler or remote application.
	389	!!----------------------------------------------------------------------
[3294]	390	INTEGER , INTENT(in ) :: kid ! variable index in the array
	391	INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds
	392	REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pdata ! IN to keep the value if nothing is done
[4990]	393	REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pmask ! coupling mask
[3294]	394	INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument
[532]	395	!!
[4990]	396	INTEGER :: jc,jm ! local loop index
	397	LOGICAL :: llaction, llfisrt
[1218]	398	!!--------------------------------------------------------------------
[532]	399	!
[1218]	400	! receive local data from OASIS3 on every process
	401	!
[4990]	402	kinfo = OASIS_idle
	403	!
[3294]	404	DO jc = 1, srcv(kid)%nct
[4990]	405	llfisrt = .TRUE.
[532]	406
[4990]	407	DO jm = 1, srcv(kid)%ncplmodel
	408
	409	IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN
	410
[8280]	411	CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo )
[4990]	412
	413	llaction = kinfo == OASIS_Recvd .OR. kinfo == OASIS_FromRest .OR. &
	414	& kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut
	415
	416	IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm)
	417
	418	IF ( llaction ) THEN
	419
	420	kinfo = OASIS_Rcv
	421	IF( llfisrt ) THEN
[8280]	422	pdata(nldi:nlei,nldj:nlej,jc) = exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm)
[4990]	423	llfisrt = .FALSE.
	424	ELSE
	425	pdata(nldi:nlei,nldj:nlej,jc) = pdata(nldi:nlei,nldj:nlej,jc) + exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm)
	426	ENDIF
	427
	428	IF ( ln_ctl ) THEN
	429	WRITE(numout,) '***************'
	430	WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname
	431	WRITE(numout,*) 'oasis_get: ivarid ' , srcv(kid)%nid(jc,jm)
	432	WRITE(numout,*) 'oasis_get: kstep', kstep
	433	WRITE(numout,*) 'oasis_get: info ', kinfo
	434	WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc))
	435	WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc))
	436	WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc))
	437	WRITE(numout,) '***************'
	438	ENDIF
	439
	440	ENDIF
	441
	442	ENDIF
[3294]	443
[4990]	444	ENDDO
[4806]	445
[4990]	446	!--- Fill the overlap areas and extra hallows (mpp)
	447	!--- check periodicity conditions (all cases)
	448	IF( .not. llfisrt ) CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn )
	449
[3294]	450	ENDDO
[2715]	451	!
[4990]	452	END SUBROUTINE cpl_rcv
[532]	453
	454
[5407]	455	INTEGER FUNCTION cpl_freq( cdfieldname )
[2528]	456	!!---------------------------------------------------------------------
[4990]	457	!! * ROUTINE cpl_freq *
[2528]	458	!!
	459	!! ** Purpose : - send back the coupling frequency for a particular field
	460	!!----------------------------------------------------------------------
[5407]	461	CHARACTER(len = *), INTENT(in) :: cdfieldname ! field name as set in namcouple file
[4990]	462	!!
[5407]	463	INTEGER :: id
[4990]	464	INTEGER :: info
	465	INTEGER, DIMENSION(1) :: itmp
[5407]	466	INTEGER :: ji,jm ! local loop index
	467	INTEGER :: mop
[2715]	468	!!----------------------------------------------------------------------
[5407]	469	cpl_freq = 0 ! defaut definition
	470	id = -1 ! defaut definition
[2715]	471	!
[5407]	472	DO ji = 1, nsnd
	473	IF (ssnd(ji)%laction ) THEN
	474	DO jm = 1, ncplmodel
	475	IF( ssnd(ji)%nid(1,jm) /= -1 ) THEN
	476	IF( TRIM(cdfieldname) == TRIM(ssnd(ji)%clname) ) THEN
	477	id = ssnd(ji)%nid(1,jm)
	478	mop = OASIS_Out
	479	ENDIF
	480	ENDIF
	481	ENDDO
	482	ENDIF
	483	ENDDO
	484	DO ji = 1, nrcv
	485	IF (srcv(ji)%laction ) THEN
	486	DO jm = 1, ncplmodel
	487	IF( srcv(ji)%nid(1,jm) /= -1 ) THEN
	488	IF( TRIM(cdfieldname) == TRIM(srcv(ji)%clname) ) THEN
	489	id = srcv(ji)%nid(1,jm)
	490	mop = OASIS_In
	491	ENDIF
	492	ENDIF
	493	ENDDO
	494	ENDIF
	495	ENDDO
	496	!
	497	IF( id /= -1 ) THEN
	498	#if defined key_oa3mct_v3
	499	CALL oasis_get_freqs(id, mop, 1, itmp, info)
	500	#else
[8280]	501	#if defined key_oasis3
	502	itmp(1) = namflddti( id )
	503	#else
[5407]	504	CALL oasis_get_freqs(id, 1, itmp, info)
	505	#endif
[8280]	506	#endif
[5407]	507	cpl_freq = itmp(1)
	508	ENDIF
	509	!
[4990]	510	END FUNCTION cpl_freq
[2528]	511
	512
[4990]	513	SUBROUTINE cpl_finalize
[532]	514	!!---------------------------------------------------------------------
[4990]	515	!! * ROUTINE cpl_finalize *
[532]	516	!!
	517	!! ** Purpose : - Finalizes the coupling. If MPI_init has not been
[4990]	518	!! called explicitly before cpl_init it will also close
[532]	519	!! MPI communication.
	520	!!----------------------------------------------------------------------
[2715]	521	!
	522	DEALLOCATE( exfld )
[4990]	523	IF (nstop == 0) THEN
	524	CALL oasis_terminate( nerror )
	525	ELSE
	526	CALL oasis_abort( ncomp_id, "cpl_finalize", "NEMO ABORT STOP" )
	527	ENDIF
[2715]	528	!
[4990]	529	END SUBROUTINE cpl_finalize
[532]	530
[4990]	531	#if ! defined key_oasis3
	532
[1218]	533	!!----------------------------------------------------------------------
[4990]	534	!! No OASIS Library OASIS3 Dummy module...
[1218]	535	!!----------------------------------------------------------------------
[4990]	536
	537	SUBROUTINE oasis_init_comp(k1,cd1,k2)
	538	CHARACTER(*), INTENT(in ) :: cd1
	539	INTEGER , INTENT( out) :: k1,k2
	540	k1 = -1 ; k2 = -1
	541	WRITE(numout,*) 'oasis_init_comp: Error you sould not be there...', cd1
	542	END SUBROUTINE oasis_init_comp
	543
	544	SUBROUTINE oasis_abort(k1,cd1,cd2)
	545	INTEGER , INTENT(in ) :: k1
	546	CHARACTER(*), INTENT(in ) :: cd1,cd2
	547	WRITE(numout,*) 'oasis_abort: Error you sould not be there...', cd1, cd2
	548	END SUBROUTINE oasis_abort
	549
	550	SUBROUTINE oasis_get_localcomm(k1,k2)
	551	INTEGER , INTENT( out) :: k1,k2
	552	k1 = -1 ; k2 = -1
	553	WRITE(numout,*) 'oasis_get_localcomm: Error you sould not be there...'
	554	END SUBROUTINE oasis_get_localcomm
	555
[8280]	556	SUBROUTINE oasis_def_partition(k1,k2,k3,K4)
[4990]	557	INTEGER , INTENT( out) :: k1,k3
	558	INTEGER , INTENT(in ) :: k2(5)
[8280]	559	INTEGER , OPTIONAL, INTENT(in ) :: k4
[4990]	560	k1 = k2(1) ; k3 = k2(5)
	561	WRITE(numout,*) 'oasis_def_partition: Error you sould not be there...'
	562	END SUBROUTINE oasis_def_partition
	563
	564	SUBROUTINE oasis_def_var(k1,cd1,k2,k3,k4,k5,k6,k7)
	565	CHARACTER(*), INTENT(in ) :: cd1
	566	INTEGER , INTENT(in ) :: k2,k3(2),k4,k5(2,2),k6
	567	INTEGER , INTENT( out) :: k1,k7
	568	k1 = -1 ; k7 = -1
	569	WRITE(numout,*) 'oasis_def_var: Error you sould not be there...', cd1
	570	END SUBROUTINE oasis_def_var
	571
	572	SUBROUTINE oasis_enddef(k1)
	573	INTEGER , INTENT( out) :: k1
	574	k1 = -1
	575	WRITE(numout,*) 'oasis_enddef: Error you sould not be there...'
	576	END SUBROUTINE oasis_enddef
	577
	578	SUBROUTINE oasis_put(k1,k2,p1,k3)
	579	REAL(wp), DIMENSION(:,:), INTENT(in ) :: p1
	580	INTEGER , INTENT(in ) :: k1,k2
	581	INTEGER , INTENT( out) :: k3
	582	k3 = -1
	583	WRITE(numout,*) 'oasis_put: Error you sould not be there...'
	584	END SUBROUTINE oasis_put
	585
	586	SUBROUTINE oasis_get(k1,k2,p1,k3)
	587	REAL(wp), DIMENSION(:,:), INTENT( out) :: p1
	588	INTEGER , INTENT(in ) :: k1,k2
	589	INTEGER , INTENT( out) :: k3
	590	p1(1,1) = -1. ; k3 = -1
	591	WRITE(numout,*) 'oasis_get: Error you sould not be there...'
	592	END SUBROUTINE oasis_get
	593
	594	SUBROUTINE oasis_get_freqs(k1,k2,k3,k4)
	595	INTEGER , INTENT(in ) :: k1,k2
	596	INTEGER, DIMENSION(1), INTENT( out) :: k3
	597	INTEGER , INTENT( out) :: k4
	598	k3(1) = k1 ; k4 = k2
	599	WRITE(numout,*) 'oasis_get_freqs: Error you sould not be there...'
	600	END SUBROUTINE oasis_get_freqs
	601
	602	SUBROUTINE oasis_terminate(k1)
	603	INTEGER , INTENT( out) :: k1
	604	k1 = -1
	605	WRITE(numout,*) 'oasis_terminate: Error you sould not be there...'
	606	END SUBROUTINE oasis_terminate
	607
[532]	608	#endif
	609
[2715]	610	!!=====================================================================
[532]	611	END MODULE cpl_oasis3

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

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

Context Navigation

source: branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90 @ 13190

Download in other formats: