Context Navigation

cpl_oasis3.F90 @ 12377

Last change on this file since 12377 was 12377, checked in by acc, 4 years ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

Property svn:keywords set to Id

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

Download in other formats: