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.

cpl_oasis3.F90 in trunk/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

Context Navigation

source: trunk/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90 @ 3294

Last change on this file since 3294 was 3294, checked in by rblod, 12 years ago
Merge of 3.4beta into the trunk
Property svn:keywords set to `Id`
File size: 16.9 KB

Rev	Line
[532]	1	MODULE cpl_oasis3
	2	!!======================================================================
	3	!! * MODULE cpl_oasis *
	4	!! Coupled O/A : coupled ocean-atmosphere case using OASIS3 V. prism_2_4
	5	!! special case: NEMO OPA/LIM coupled to ECHAM5
	6	!!=====================================================================
	7	!! History :
[2715]	8	!! 9.0 ! 04-06 (R. Redler, NEC Laboratories Europe, Germany) Original code
	9	!! " " ! 04-11 (R. Redler, NEC Laboratories Europe; N. Keenlyside, W. Park, IFM-GEOMAR, Germany) revision
[532]	10	!! " " ! 04-11 (V. Gayler, MPI M&D) Grid writing
	11	!! " " ! 05-08 (R. Redler, W. Park) frld initialization, paral(2) revision
	12	!! " " ! 05-09 (R. Redler) extended to allow for communication over root only
	13	!! " " ! 06-01 (W. Park) modification of physical part
	14	!! " " ! 06-02 (R. Redler, W. Park) buffer array fix for root exchange
[3294]	15	!! 3.4 ! 11-11 (C. Harris) Changes to allow mutiple category fields
[532]	16	!!----------------------------------------------------------------------
	17	#if defined key_oasis3
	18	!!----------------------------------------------------------------------
	19	!! 'key_oasis3' coupled Ocean/Atmosphere via OASIS3
	20	!!----------------------------------------------------------------------
	21	!! cpl_prism_init : initialization of coupled mode communication
	22	!! cpl_prism_define : definition of grid and fields
[1218]	23	!! cpl_prism_snd : snd out fields in coupled mode
	24	!! cpl_prism_rcv : receive fields in coupled mode
[532]	25	!! cpl_prism_finalize : finalize the coupled mode communication
	26	!!----------------------------------------------------------------------
[1218]	27	USE mod_prism_proto ! OASIS3 prism module
	28	USE mod_prism_def_partition_proto! OASIS3 prism module for partitioning
	29	USE mod_prism_put_proto ! OASIS3 prism module for snding
	30	USE mod_prism_get_proto ! OASIS3 prism module for receiving
[2528]	31	USE mod_comprism_proto ! OASIS3 prism module to get coupling frequency
[1218]	32	USE par_oce ! ocean parameters
[532]	33	USE dom_oce ! ocean space and time domain
	34	USE in_out_manager ! I/O manager
[2715]	35	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
	36
[532]	37	IMPLICIT NONE
[1218]	38	PRIVATE
[532]	39
[2715]	40	PUBLIC cpl_prism_init
	41	PUBLIC cpl_prism_define
	42	PUBLIC cpl_prism_snd
	43	PUBLIC cpl_prism_rcv
	44	PUBLIC cpl_prism_freq
	45	PUBLIC cpl_prism_finalize
	46
	47	LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .TRUE. !: coupled flag
	48	INTEGER, PUBLIC :: OASIS_Rcv = 1 !: return code if received field
	49	INTEGER, PUBLIC :: OASIS_idle = 0 !: return code if nothing done by oasis
	50	INTEGER :: ncomp_id ! id returned by prism_init_comp
	51	INTEGER :: nerror ! return error code
	52
	53	INTEGER, PARAMETER :: nmaxfld=40 ! Maximum number of coupling fields
[1218]	54
[3294]	55	TYPE, PUBLIC :: FLD_CPL !: Type for coupling field information
	56	LOGICAL :: laction ! To be coupled or not
	57	CHARACTER(len = 8) :: clname ! Name of the coupling field
	58	CHARACTER(len = 1) :: clgrid ! Grid type
	59	REAL(wp) :: nsgn ! Control of the sign change
	60	INTEGER, DIMENSION(9) :: nid ! Id of the field (no more than 9 categories)
	61	INTEGER :: nct ! Number of categories in field
[1218]	62	END TYPE FLD_CPL
[532]	63
[2715]	64	TYPE(FLD_CPL), DIMENSION(nmaxfld), PUBLIC :: srcv, ssnd !: Coupling fields
[532]	65
[2715]	66	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: exfld ! Temporary buffer for receiving
[532]	67
	68	!!----------------------------------------------------------------------
[2528]	69	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
	70	!! $Id$
[2715]	71	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[532]	72	!!----------------------------------------------------------------------
	73	CONTAINS
	74
[2715]	75	SUBROUTINE cpl_prism_init( kl_comm )
[532]	76	!!-------------------------------------------------------------------
	77	!! * ROUTINE cpl_prism_init *
	78	!!
	79	!! ** Purpose : Initialize coupled mode communication for ocean
	80	!! exchange between AGCM, OGCM and COUPLER. (OASIS3 software)
	81	!!
	82	!! ** Method : OASIS3 MPI communication
	83	!!--------------------------------------------------------------------
[2715]	84	INTEGER, INTENT(out) :: kl_comm ! local communicator of the model
[1226]	85	!!--------------------------------------------------------------------
[1218]	86
[1579]	87	! WARNING: No write in numout in this routine
	88	!============================================
	89
[532]	90	!------------------------------------------------------------------
	91	! 1st Initialize the PRISM system for the application
	92	!------------------------------------------------------------------
[1218]	93	CALL prism_init_comp_proto ( ncomp_id, 'oceanx', nerror )
	94	IF ( nerror /= PRISM_Ok ) &
	95	CALL prism_abort_proto (ncomp_id, 'cpl_prism_init', 'Failure in prism_init_comp_proto')
[532]	96
	97	!------------------------------------------------------------------
	98	! 3rd Get an MPI communicator for OPA local communication
	99	!------------------------------------------------------------------
	100
[1226]	101	CALL prism_get_localcomm_proto ( kl_comm, nerror )
[1218]	102	IF ( nerror /= PRISM_Ok ) &
	103	CALL prism_abort_proto (ncomp_id, 'cpl_prism_init','Failure in prism_get_localcomm_proto' )
[2715]	104	!
[532]	105	END SUBROUTINE cpl_prism_init
	106
	107
[2715]	108	SUBROUTINE cpl_prism_define( krcv, ksnd )
[532]	109	!!-------------------------------------------------------------------
	110	!! * ROUTINE cpl_prism_define *
	111	!!
	112	!! ** Purpose : Define grid and field information for ocean
	113	!! exchange between AGCM, OGCM and COUPLER. (OASIS3 software)
	114	!!
	115	!! ** Method : OASIS3 MPI communication
	116	!!--------------------------------------------------------------------
[2715]	117	INTEGER, INTENT(in) :: krcv, ksnd ! Number of received and sent coupling fields
[1226]	118	!
[2715]	119	INTEGER :: id_part
	120	INTEGER :: paral(5) ! OASIS3 box partition
	121	INTEGER :: ishape(2,2) ! shape of arrays passed to PSMILe
[3294]	122	INTEGER :: ji,jc ! local loop indicees
	123	CHARACTER(LEN=8) :: zclname
[532]	124	!!--------------------------------------------------------------------
[1218]	125
[532]	126	IF(lwp) WRITE(numout,*)
	127	IF(lwp) WRITE(numout,*) 'cpl_prism_define : initialization in coupled ocean/atmosphere case'
	128	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~'
	129	IF(lwp) WRITE(numout,*)
	130
	131	!
	132	! ... Define the shape for the area that excludes the halo
	133	! For serial configuration (key_mpp_mpi not being active)
	134	! nl* is set to the global values 1 and jp*glo.
	135	!
[1218]	136	ishape(:,1) = (/ 1, nlei-nldi+1 /)
	137	ishape(:,2) = (/ 1, nlej-nldj+1 /)
[532]	138	!
	139	! ... Allocate memory for data exchange
	140	!
[1218]	141	ALLOCATE(exfld(nlei-nldi+1, nlej-nldj+1), stat = nerror)
[2715]	142	IF( nerror > 0 ) THEN
	143	CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in allocating exfld') ; RETURN
[532]	144	ENDIF
	145	!
[1218]	146	! -----------------------------------------------------------------
	147	! ... Define the partition
	148	! -----------------------------------------------------------------
	149
	150	paral(1) = 2 ! box partitioning
	151	paral(2) = jpiglo * (nldj-1+njmpp-1) + (nldi-1+nimpp-1) ! NEMO lower left corner global offset
	152	paral(3) = nlei-nldi+1 ! local extent in i
	153	paral(4) = nlej-nldj+1 ! local extent in j
	154	paral(5) = jpiglo ! global extent in x
	155
	156	IF( ln_ctl ) THEN
	157	WRITE(numout,*) ' multiexchg: paral (1:5)', paral
	158	WRITE(numout,*) ' multiexchg: jpi, jpj =', jpi, jpj
	159	WRITE(numout,*) ' multiexchg: nldi, nlei, nimpp =', nldi, nlei, nimpp
	160	WRITE(numout,*) ' multiexchg: nldj, nlej, njmpp =', nldj, nlej, njmpp
	161	ENDIF
	162
	163	CALL prism_def_partition_proto ( id_part, paral, nerror )
[532]	164	!
[1218]	165	! ... Announce send variables.
[532]	166	!
[1226]	167	DO ji = 1, ksnd
[1218]	168	IF ( ssnd(ji)%laction ) THEN
[3294]	169	DO jc = 1, ssnd(ji)%nct
	170	IF ( ssnd(ji)%nct .gt. 1 ) THEN
	171	WRITE(zclname,'( a7, i1)') ssnd(ji)%clname,jc
	172	ELSE
	173	zclname=ssnd(ji)%clname
	174	ENDIF
	175	WRITE(numout,*) "Define",ji,jc,zclname," for",PRISM_Out
	176	CALL prism_def_var_proto (ssnd(ji)%nid(jc), zclname, id_part, (/ 2, 0/), &
	177	PRISM_Out, ishape, PRISM_REAL, nerror)
	178	IF ( nerror /= PRISM_Ok ) THEN
	179	WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname)
	180	CALL prism_abort_proto ( ssnd(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var')
	181	ENDIF
	182	END DO
[1218]	183	ENDIF
	184	END DO
	185	!
	186	! ... Announce received variables.
	187	!
[1226]	188	DO ji = 1, krcv
[1218]	189	IF ( srcv(ji)%laction ) THEN
[3294]	190	DO jc = 1, srcv(ji)%nct
	191	IF ( srcv(ji)%nct .gt. 1 ) THEN
	192	WRITE(zclname,'( a7, i1)') srcv(ji)%clname,jc
	193	ELSE
	194	zclname=srcv(ji)%clname
	195	ENDIF
	196	WRITE(numout,*) "Define",ji,jc,zclname," for",PRISM_In
	197	CALL prism_def_var_proto ( srcv(ji)%nid(jc), zclname, id_part, (/ 2, 0/), &
	198	& PRISM_In , ishape , PRISM_REAL, nerror)
	199	IF ( nerror /= PRISM_Ok ) THEN
	200	WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname)
	201	CALL prism_abort_proto ( srcv(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var')
	202	ENDIF
	203	END DO
[1218]	204	ENDIF
	205	END DO
	206
[532]	207	!------------------------------------------------------------------
[1218]	208	! End of definition phase
[532]	209	!------------------------------------------------------------------
[1218]	210
	211	CALL prism_enddef_proto(nerror)
[2715]	212	IF( nerror /= PRISM_Ok ) CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in prism_enddef')
	213	!
[532]	214	END SUBROUTINE cpl_prism_define
[1218]	215
	216
	217	SUBROUTINE cpl_prism_snd( kid, kstep, pdata, kinfo )
[532]	218	!!---------------------------------------------------------------------
[1218]	219	!! * ROUTINE cpl_prism_snd *
[532]	220	!!
	221	!! ** Purpose : - At each coupling time-step,this routine sends fields
	222	!! like sst or ice cover to the coupler or remote application.
	223	!!----------------------------------------------------------------------
[3294]	224	INTEGER , INTENT(in ) :: kid ! variable index in the array
	225	INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument
	226	INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds
	227	REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pdata
	228	!!
	229	INTEGER :: jc ! local loop index
[532]	230	!!--------------------------------------------------------------------
	231	!
[1218]	232	! snd data to OASIS3
[532]	233	!
[3294]	234	DO jc = 1, ssnd(kid)%nct
	235
	236	CALL prism_put_proto ( ssnd(kid)%nid(jc), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo )
	237
	238	IF ( ln_ctl ) THEN
	239	IF ( kinfo == PRISM_Sent .OR. kinfo == PRISM_ToRest .OR. &
	240	& kinfo == PRISM_SentOut .OR. kinfo == PRISM_ToRestOut ) THEN
	241	WRITE(numout,) '***************'
	242	WRITE(numout,*) 'prism_put_proto: Outgoing ', ssnd(kid)%clname
	243	WRITE(numout,*) 'prism_put_proto: ivarid ', ssnd(kid)%nid(jc)
	244	WRITE(numout,*) 'prism_put_proto: kstep ', kstep
	245	WRITE(numout,*) 'prism_put_proto: info ', kinfo
	246	WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc))
	247	WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc))
	248	WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc))
	249	WRITE(numout,) '***************'
	250	ENDIF
[2715]	251	ENDIF
[3294]	252
	253	ENDDO
[2715]	254	!
[1218]	255	END SUBROUTINE cpl_prism_snd
[532]	256
	257
[1218]	258	SUBROUTINE cpl_prism_rcv( kid, kstep, pdata, kinfo )
[532]	259	!!---------------------------------------------------------------------
[1218]	260	!! * ROUTINE cpl_prism_rcv *
[532]	261	!!
	262	!! ** Purpose : - At each coupling time-step,this routine receives fields
	263	!! like stresses and fluxes from the coupler or remote application.
	264	!!----------------------------------------------------------------------
[3294]	265	INTEGER , INTENT(in ) :: kid ! variable index in the array
	266	INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds
	267	REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pdata ! IN to keep the value if nothing is done
	268	INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument
[532]	269	!!
[3294]	270	INTEGER :: jc ! local loop index
	271	LOGICAL :: llaction
[1218]	272	!!--------------------------------------------------------------------
[532]	273	!
[1218]	274	! receive local data from OASIS3 on every process
	275	!
[3294]	276	DO jc = 1, srcv(kid)%nct
[532]	277
[3294]	278	CALL prism_get_proto ( srcv(kid)%nid(jc), kstep, exfld, kinfo )
[1218]	279
[3294]	280	llaction = .false.
	281	IF( kinfo == PRISM_Recvd .OR. kinfo == PRISM_FromRest .OR. &
	282	kinfo == PRISM_RecvOut .OR. kinfo == PRISM_FromRestOut ) llaction = .TRUE.
[1218]	283
[3294]	284	IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc)
	285
	286	IF ( llaction ) THEN
	287
	288	kinfo = OASIS_Rcv
	289	pdata(nldi:nlei, nldj:nlej,jc) = exfld(:,:)
	290
	291	!--- Fill the overlap areas and extra hallows (mpp)
	292	!--- check periodicity conditions (all cases)
	293	CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn )
	294
	295	IF ( ln_ctl ) THEN
	296	WRITE(numout,) '***************'
	297	WRITE(numout,*) 'prism_get_proto: Incoming ', srcv(kid)%clname
	298	WRITE(numout,*) 'prism_get_proto: ivarid ' , srcv(kid)%nid(jc)
	299	WRITE(numout,*) 'prism_get_proto: kstep', kstep
	300	WRITE(numout,*) 'prism_get_proto: info ', kinfo
	301	WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc))
	302	WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc))
	303	WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc))
	304	WRITE(numout,) '***************'
	305	ENDIF
	306
	307	ELSE
	308	kinfo = OASIS_idle
[532]	309	ENDIF
[3294]	310
	311	ENDDO
[2715]	312	!
[1218]	313	END SUBROUTINE cpl_prism_rcv
[532]	314
	315
[2715]	316	INTEGER FUNCTION cpl_prism_freq( kid )
[2528]	317	!!---------------------------------------------------------------------
	318	!! * ROUTINE cpl_prism_freq *
	319	!!
	320	!! ** Purpose : - send back the coupling frequency for a particular field
	321	!!----------------------------------------------------------------------
[2715]	322	INTEGER,INTENT(in) :: kid ! variable index
	323	!!----------------------------------------------------------------------
[2528]	324	cpl_prism_freq = ig_def_freq( kid )
[2715]	325	!
[2528]	326	END FUNCTION cpl_prism_freq
	327
	328
[532]	329	SUBROUTINE cpl_prism_finalize
	330	!!---------------------------------------------------------------------
	331	!! * ROUTINE cpl_prism_finalize *
	332	!!
	333	!! ** Purpose : - Finalizes the coupling. If MPI_init has not been
	334	!! called explicitly before cpl_prism_init it will also close
	335	!! MPI communication.
	336	!!----------------------------------------------------------------------
[2715]	337	!
	338	DEALLOCATE( exfld )
	339	CALL prism_terminate_proto( nerror )
	340	!
[1218]	341	END SUBROUTINE cpl_prism_finalize
[532]	342
[1218]	343	#else
	344	!!----------------------------------------------------------------------
[2715]	345	!! Default case Dummy module Forced Ocean/Atmosphere
[1218]	346	!!----------------------------------------------------------------------
	347	USE in_out_manager ! I/O manager
	348	LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .FALSE. !: coupled flag
	349	PUBLIC cpl_prism_init
	350	PUBLIC cpl_prism_finalize
	351	CONTAINS
[1226]	352	SUBROUTINE cpl_prism_init (kl_comm)
[2715]	353	INTEGER, INTENT(out) :: kl_comm ! local communicator of the model
[1226]	354	kl_comm = -1
[1218]	355	WRITE(numout,*) 'cpl_prism_init: Error you sould not be there...'
	356	END SUBROUTINE cpl_prism_init
	357	SUBROUTINE cpl_prism_finalize
	358	WRITE(numout,*) 'cpl_prism_finalize: Error you sould not be there...'
[532]	359	END SUBROUTINE cpl_prism_finalize
	360	#endif
	361
[2715]	362	!!=====================================================================
[532]	363	END MODULE cpl_oasis3

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

Download in other formats: