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.

nemogcm.F90 in utils/tools/DOMAINcfg/src – NEMO

Context Navigation

source: utils/tools/DOMAINcfg/src/nemogcm.F90 @ 13826

Last change on this file since 13826 was 13204, checked in by smasson, 4 years ago
tools: update with tools_dev_r12970_AGRIF_CMEMS
File size: 21.6 KB

Rev	Line
[6951]	1	MODULE nemogcm
	2	!!======================================================================
	3	!! * MODULE nemogcm *
	4	!! Ocean system : NEMO GCM (ocean dynamics, on-line tracers, biochemistry and sea-ice)
	5	!!======================================================================
	6	!! History : OPA ! 1990-10 (C. Levy, G. Madec) Original code
	7	!! 7.0 ! 1991-11 (M. Imbard, C. Levy, G. Madec)
	8	!! 7.1 ! 1993-03 (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar,
	9	!! P. Delecluse, C. Perigaud, G. Caniaux, B. Colot, C. Maes) release 7.1
	10	!! - ! 1992-06 (L.Terray) coupling implementation
	11	!! - ! 1993-11 (M.A. Filiberti) IGLOO sea-ice
	12	!! 8.0 ! 1996-03 (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar,
	13	!! P. Delecluse, L.Terray, M.A. Filiberti, J. Vialar, A.M. Treguier, M. Levy) release 8.0
	14	!! 8.1 ! 1997-06 (M. Imbard, G. Madec)
	15	!! 8.2 ! 1999-11 (M. Imbard, H. Goosse) LIM sea-ice model
	16	!! ! 1999-12 (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols) OPEN-MP
	17	!! ! 2000-07 (J-M Molines, M. Imbard) Open Boundary Conditions (CLIPPER)
	18	!! NEMO 1.0 ! 2002-08 (G. Madec) F90: Free form and modules
	19	!! - ! 2004-06 (R. Redler, NEC CCRLE, Germany) add OASIS[3/4] coupled interfaces
	20	!! - ! 2004-08 (C. Talandier) New trends organization
	21	!! - ! 2005-06 (C. Ethe) Add the 1D configuration possibility
	22	!! - ! 2005-11 (V. Garnier) Surface pressure gradient organization
	23	!! - ! 2006-03 (L. Debreu, C. Mazauric) Agrif implementation
	24	!! - ! 2006-04 (G. Madec, R. Benshila) Step reorganization
	25	!! - ! 2007-07 (J. Chanut, A. Sellar) Unstructured open boundaries (BDY)
	26	!! 3.2 ! 2009-08 (S. Masson) open/write in the listing file in mpp
	27	!! 3.3 ! 2010-05 (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface
	28	!! - ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase
	29	!! 3.3.1! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation
	30	!! 3.4 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) add nemo_northcomms
	31	!! - ! 2011-11 (C. Harris) decomposition changes for running with CICE
	32	!! 3.6 ! 2012-05 (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening
	33	!! - ! 2013-06 (I. Epicoco, S. Mocavero, CMCC) nemo_northcomms: setup avoiding MPI communication
	34	!! - ! 2014-12 (G. Madec) remove KPP scheme and cross-land advection (cla)
	35	!!----------------------------------------------------------------------
	36
	37	!!----------------------------------------------------------------------
	38	!! nemo_gcm : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice
	39	!! nemo_init : initialization of the NEMO system
	40	!! nemo_ctl : initialisation of the contol print
	41	!! nemo_closefile: close remaining open files
	42	!! nemo_alloc : dynamical allocation
	43	!! nemo_partition: calculate MPP domain decomposition
	44	!! factorise : calculate the factors of the no. of MPI processes
	45	!!----------------------------------------------------------------------
[12101]	46	USE dom_oce ! ocean space and time domain variables
	47	USE in_out_manager ! I/O manager
	48	USE iom !
[6951]	49	USE domcfg ! domain configuration (dom_cfg routine)
	50	USE mppini ! shared/distributed memory setting (mpp_init routine)
	51	USE domain ! domain initialization (dom_init routine)
	52	USE phycst ! physical constant (par_cst routine)
	53	USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
	54	USE lib_mpp ! distributed memory computing
	55
	56	USE lbcnfd , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges
	57
[13204]	58	USE agrif_connect
	59	USE agrif_dom_update
	60	USE agrif_recompute_scales
	61
[6951]	62	IMPLICIT NONE
	63	PRIVATE
	64
	65	PUBLIC nemo_gcm ! called by model.F90
	66	PUBLIC nemo_init ! needed by AGRIF
	67	PUBLIC nemo_alloc ! needed by TAM
	68
	69	CHARACTER(lc) :: cform_aaa="( /, 'AAAAAAAA', / ) " ! flag for output listing
	70
	71	!!----------------------------------------------------------------------
	72	!! NEMO/OPA 3.7 , NEMO Consortium (2015)
	73	!! $Id: nemogcm.F90 6152 2015-12-21 22:33:57Z acc $
[9598]	74	!! Software governed by the CeCILL licence (./LICENSE)
[6951]	75	!!----------------------------------------------------------------------
	76	CONTAINS
	77
	78	SUBROUTINE nemo_gcm
	79	!!----------------------------------------------------------------------
	80	!! * ROUTINE nemo_gcm *
	81	!!
	82	!! ** Purpose : NEMO solves the primitive equations on an orthogonal
	83	!! curvilinear mesh on the sphere.
	84	!!
	85	!! ** Method : - model general initialization
	86	!! - launch the time-stepping (stp routine)
	87	!! - finalize the run by closing files and communications
	88	!!
	89	!! References : Madec, Delecluse, Imbard, and Levy, 1997: internal report, IPSL.
	90	!! Madec, 2008, internal report, IPSL.
	91	!!----------------------------------------------------------------------
	92	INTEGER :: istp ! time step index
	93	!!----------------------------------------------------------------------
	94	!
[10727]	95	#if defined key_agrif
	96	CALL Agrif_Init_Grids() ! AGRIF: set the meshes
	97	#endif
[6951]	98	! !-----------------------!
	99	CALL nemo_init !== Initialisations ==!
	100	! !-----------------------!
	101
[10727]	102	#if defined key_agrif
	103	CALL Agrif_Regrid()
	104
	105	CALL Agrif_Step_Child(agrif_boundary_connections)
	106
	107	CALL Agrif_Step_Child_adj(agrif_update_all)
	108
	109	CALL Agrif_Step_Child(agrif_recompute_scalefactors)
	110
	111	CALL Agrif_Step_Child(cfg_write)
	112	#endif
	113
[6951]	114	! check that all process are still there... If some process have an error,
	115	! they will never enter in step and other processes will wait until the end of the cpu time!
[10727]	116	IF( lk_mpp ) CALL mpp_max( 'nemogcm',nstop )
[6951]	117
	118	IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
	119
	120	! !-----------------------!
	121	! !== finalize the run ==!
	122	! !------------------------!
	123	!
	124	IF( nstop /= 0 .AND. lwp ) THEN ! error print
	125	WRITE(numout,cform_err)
	126	WRITE(numout,*) nstop, ' error have been found'
	127	ENDIF
	128	!
	129	!
	130	CALL nemo_closefile
	131	!
	132	!
	133	END SUBROUTINE nemo_gcm
	134
	135
	136	SUBROUTINE nemo_init
	137	!!----------------------------------------------------------------------
	138	!! * ROUTINE nemo_init *
	139	!!
	140	!! ** Purpose : initialization of the NEMO GCM
	141	!!----------------------------------------------------------------------
[10727]	142	INTEGER :: ji ! dummy loop indices
	143	INTEGER :: ios, ilocal_comm ! local integers
	144	CHARACTER(len=120), DIMENSION(60) :: cltxt, cltxt2, clnam
[12101]	145	!!
[7200]	146	NAMELIST/namcfg/ ln_e3_dep, &
[7189]	147	& cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, &
[12101]	148	& jperio, ln_use_jattr, ln_domclo
[6951]	149	!!----------------------------------------------------------------------
	150	!
	151	cltxt = ''
	152	!
	153	! ! Open reference namelist and configuration namelist files
	154	CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
	155	CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
	156	!
[12101]	157	REWIND( numnam_ref ) ! Namelist namcfg in reference namelist
[6951]	158	READ ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
[12101]	159	903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. )
	160	REWIND( numnam_cfg ) ! Namelist namcfg in confguration namelist
[6951]	161	READ ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
[12101]	162	904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )
[6951]	163
	164	! Force values for AGRIF zoom (cf. agrif_user.F90)
	165	!
	166	! !--------------------------------------------!
	167	! ! set communicator & select the local node !
	168	! ! NB: mynode also opens output.namelist.dyn !
	169	! ! on unit number numond on first proc !
	170	! !--------------------------------------------!
	171	! Nodes selection (control print return in cltxt)
[9079]	172	narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop )
[6951]	173	narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 )
	174
	175	lwm = (narea == 1) ! control of output namelists
[13204]	176	lwp = (narea == 1) ! control of all listing output print
[6951]	177
	178	IF(lwm) THEN
	179	! write merged namelists from earlier to output namelist now that the
	180	! file has been opened in call to mynode. nammpp has already been
	181	! written in mynode (if lk_mpp_mpi)
	182	WRITE( numond, namcfg )
	183	ENDIF
	184
[10727]	185	IF(lwp) THEN ! open listing units
[6951]	186	!
	187	CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
	188	!
	189	WRITE(numout,*)
	190	WRITE(numout,*) ' CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV - CMCC'
	191	WRITE(numout,*) ' NEMO team'
	192	WRITE(numout,*) ' Ocean General Circulation Model'
[10727]	193	WRITE(numout,*) ' NEMO version 4.0 (2019) '
[6951]	194	WRITE(numout,*)
[10727]	195	WRITE(numout,*) " ._ ._ ._ ._ ._ "
	196	WRITE(numout,*) " _.-._)`\_.-._)`\_.-._)`\_.-._)`\_.-._)`\_ "
[6951]	197	WRITE(numout,*)
[10727]	198	WRITE(numout,*) " o _, _, "
	199	WRITE(numout,*) " o .' ( .-' / "
	200	WRITE(numout,*) " o _/..._'. .' / "
	201	WRITE(numout,*) " ( o .-'` ` '-./ _.' "
	202	WRITE(numout,*) " ) ( o) ;= <_ ( "
	203	WRITE(numout,*) " ( '-.,\\__ __.-;`\ '. ) "
	204	WRITE(numout,*) " ) ) \) \|`\ \) '. \ ( ( "
	205	WRITE(numout,*) " ( ( \_/ '-._\ ) ) "
	206	WRITE(numout,*) " ) ) ` ( ( "
	207	WRITE(numout,*) " ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ "
	208	WRITE(numout,*)
	209
[6951]	210	DO ji = 1, SIZE(cltxt)
[10727]	211	IF( TRIM(cltxt (ji)) /= '' ) WRITE(numout,*) TRIM(cltxt(ji)) ! control print of mynode
[6951]	212	END DO
[10727]	213	WRITE(numout,*)
	214	WRITE(numout,*)
	215	! DO ji = 1, SIZE(cltxt2)
	216	! IF( TRIM(cltxt2(ji)) /= '' ) WRITE(numout,*) TRIM(cltxt2(ji)) ! control print of domain size
	217	! END DO
[6951]	218	!
[10727]	219	WRITE(numout,cform_aaa) ! Flag AAAAAAA
	220	!
[6951]	221	ENDIF
[10727]	222	! open /dev/null file to be able to supress output write easily
	223	! CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
	224	!
	225	! ! Domain decomposition
	226	CALL mpp_init ! MPP
[6951]	227
[10727]	228	! IF( Agrif_Root() ) THEN
	229	! jpi = ( jpiglo -2jpreci + (jpni-1) ) / jpni + 2jpreci ! first dim.
	230	! jpj = ( jpjglo -2jprecj + (jpnj-1) ) / jpnj + 2jprecj ! second dim.
	231	! ENDIF
	232	jpk = jpkdta ! third dim
	233	jpim1 = jpi-1 ! inner domain indices
	234	jpjm1 = jpj-1 ! " "
	235	jpkm1 = jpk-1 ! " "
	236	jpij = jpi*jpj ! jpi x j
	237
	238	#if defined key_agrif
	239	CALL Agrif_Declare_Var
	240	#endif
	241
	242	! Now we know the dimensions of the grid and numout has been set: we can allocate arrays
[6951]	243	CALL nemo_alloc()
	244
	245	! !-------------------------------!
	246	! ! NEMO general initialization !
	247	! !-------------------------------!
	248
	249	! ! Domain decomposition
[10727]	250	!
[6951]	251	! ! General initialization
	252	CALL phy_cst ! Physical constants
	253	CALL dom_cfg ! Domain configuration
	254	CALL dom_init ! Domain
	255	!
	256	END SUBROUTINE nemo_init
	257
	258	SUBROUTINE nemo_closefile
	259	!!----------------------------------------------------------------------
	260	!! * ROUTINE nemo_closefile *
	261	!!
	262	!! ** Purpose : Close the files
	263	!!----------------------------------------------------------------------
	264	!
	265	IF( lk_mpp ) CALL mppsync
	266	!
	267	CALL iom_close ! close all input/output files managed by iom_*
	268	!
	269	IF( numstp /= -1 ) CLOSE( numstp ) ! time-step file
	270	IF( numnam_ref /= -1 ) CLOSE( numnam_ref ) ! oce reference namelist
	271	IF( numnam_cfg /= -1 ) CLOSE( numnam_cfg ) ! oce configuration namelist
	272	IF( lwm.AND.numond /= -1 ) CLOSE( numond ) ! oce output namelist
	273	IF( numout /= 6 ) CLOSE( numout ) ! standard model output file
	274	!
	275	numout = 6 ! redefine numout in case it is used after this point...
	276	!
	277	END SUBROUTINE nemo_closefile
	278
	279
	280	SUBROUTINE nemo_alloc
	281	!!----------------------------------------------------------------------
	282	!! * ROUTINE nemo_alloc *
	283	!!
	284	!! ** Purpose : Allocate all the dynamic arrays of the OPA modules
	285	!!
	286	!! ** Method :
	287	!!----------------------------------------------------------------------
	288	USE dom_oce , ONLY: dom_oce_alloc
	289	!
	290	INTEGER :: ierr
	291	!!----------------------------------------------------------------------
	292	!
[13204]	293	ierr = 0
	294	ierr = ierr + dom_oce_alloc () ! ocean domain
[6951]	295	!
[10727]	296	CALL mpp_sum( 'nemogcm', ierr )
[6951]	297	IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'nemo_alloc : unable to allocate standard ocean arrays' )
	298	!
	299	END SUBROUTINE nemo_alloc
	300
	301
[13204]	302	SUBROUTINE nemo_partition( num_pes )
	303	!!----------------------------------------------------------------------
	304	!! * ROUTINE nemo_partition *
	305	!!
	306	!! ** Purpose :
	307	!!
	308	!! ** Method :
	309	!!----------------------------------------------------------------------
	310	INTEGER, INTENT(in) :: num_pes ! The number of MPI processes we have
	311	!
	312	INTEGER, PARAMETER :: nfactmax = 20
	313	INTEGER :: nfact ! The no. of factors returned
	314	INTEGER :: ierr ! Error flag
	315	INTEGER :: ji
	316	INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are closest in value
	317	INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors
	318	!!----------------------------------------------------------------------
	319	!
	320	ierr = 0
	321	!
	322	CALL factorise( ifact, nfactmax, nfact, num_pes, ierr )
	323	!
	324	IF( nfact <= 1 ) THEN
	325	WRITE (numout, *) 'WARNING: factorisation of number of PEs failed'
	326	WRITE (numout, *) ' : using grid of ',num_pes,' x 1'
	327	jpnj = 1
	328	jpni = num_pes
	329	ELSE
	330	! Search through factors for the pair that are closest in value
	331	mindiff = 1000000
	332	imin = 1
	333	DO ji = 1, nfact-1, 2
	334	idiff = ABS( ifact(ji) - ifact(ji+1) )
	335	IF( idiff < mindiff ) THEN
	336	mindiff = idiff
	337	imin = ji
	338	ENDIF
	339	END DO
	340	jpnj = ifact(imin)
	341	jpni = ifact(imin + 1)
	342	ENDIF
	343	!
	344	jpnij = jpni*jpnj
	345	!
	346	END SUBROUTINE nemo_partition
[6951]	347
[13204]	348
	349	SUBROUTINE factorise( kfax, kmaxfax, knfax, kn, kerr )
	350	!!----------------------------------------------------------------------
	351	!! * ROUTINE factorise *
	352	!!
	353	!! ** Purpose : return the prime factors of n.
	354	!! knfax factors are returned in array kfax which is of
	355	!! maximum dimension kmaxfax.
	356	!! ** Method :
	357	!!----------------------------------------------------------------------
	358	INTEGER , INTENT(in ) :: kn, kmaxfax
	359	INTEGER , INTENT( out) :: kerr, knfax
	360	INTEGER, DIMENSION(kmaxfax), INTENT( out) :: kfax
	361	!
	362	INTEGER :: ifac, jl, inu
	363	INTEGER, PARAMETER :: ntest = 14
	364	INTEGER, DIMENSION(ntest) :: ilfax
	365	!!----------------------------------------------------------------------
	366	!
	367	! lfax contains the set of allowed factors.
	368	ilfax(:) = (/(2**jl,jl=ntest,1,-1)/)
	369	!
	370	! Clear the error flag and initialise output vars
	371	kerr = 0
	372	kfax = 1
	373	knfax = 0
	374	!
	375	! Find the factors of n.
	376	IF( kn == 1 ) GOTO 20
	377
	378	! nu holds the unfactorised part of the number.
	379	! knfax holds the number of factors found.
	380	! l points to the allowed factor list.
	381	! ifac holds the current factor.
	382	!
	383	inu = kn
	384	knfax = 0
	385	!
	386	DO jl = ntest, 1, -1
	387	!
	388	ifac = ilfax(jl)
	389	IF( ifac > inu ) CYCLE
	390
	391	! Test whether the factor will divide.
	392
	393	IF( MOD(inu,ifac) == 0 ) THEN
	394	!
	395	knfax = knfax + 1 ! Add the factor to the list
	396	IF( knfax > kmaxfax ) THEN
	397	kerr = 6
	398	write (,) 'FACTOR: insufficient space in factor array ', knfax
	399	return
	400	ENDIF
	401	kfax(knfax) = ifac
	402	! Store the other factor that goes with this one
	403	knfax = knfax + 1
	404	kfax(knfax) = inu / ifac
	405	!WRITE (,) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax)
	406	ENDIF
	407	!
	408	END DO
	409	!
	410	20 CONTINUE ! Label 20 is the exit point from the factor search loop.
	411	!
	412	END SUBROUTINE factorise
	413
	414
	415	SUBROUTINE nemo_northcomms
	416	!!----------------------------------------------------------------------
	417	!! * ROUTINE nemo_northcomms *
	418	!! ** Purpose : Setup for north fold exchanges with explicit
	419	!! point-to-point messaging
	420	!!
	421	!! ** Method : Initialization of the northern neighbours lists.
	422	!!----------------------------------------------------------------------
	423	!! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE)
	424	!! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC)
	425	!!----------------------------------------------------------------------
	426	INTEGER :: sxM, dxM, sxT, dxT, jn
	427	INTEGER :: njmppmax
	428	!!----------------------------------------------------------------------
	429	!
	430	njmppmax = MAXVAL( njmppt )
	431	!
	432	!initializes the north-fold communication variables
	433	isendto(:) = 0
	434	nsndto = 0
	435	!
	436	!if I am a process in the north
	437	IF ( njmpp == njmppmax ) THEN
	438	!sxM is the first point (in the global domain) needed to compute the
	439	!north-fold for the current process
	440	sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1
	441	!dxM is the last point (in the global domain) needed to compute the
	442	!north-fold for the current process
	443	dxM = jpiglo - nimppt(narea) + 2
	444
	445	!loop over the other north-fold processes to find the processes
	446	!managing the points belonging to the sxT-dxT range
	447
	448	DO jn = 1, jpni
	449	!sxT is the first point (in the global domain) of the jn
	450	!process
	451	sxT = nfiimpp(jn, jpnj)
	452	!dxT is the last point (in the global domain) of the jn
	453	!process
	454	dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1
	455	IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN
	456	nsndto = nsndto + 1
	457	isendto(nsndto) = jn
	458	ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN
	459	nsndto = nsndto + 1
	460	isendto(nsndto) = jn
	461	ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN
	462	nsndto = nsndto + 1
	463	isendto(nsndto) = jn
	464	END IF
	465	END DO
	466	nfsloop = 1
	467	nfeloop = nlci
	468	DO jn = 2,jpni-1
	469	IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN
	470	IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN
	471	nfsloop = nldi
	472	ENDIF
	473	IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN
	474	nfeloop = nlei
	475	ENDIF
	476	ENDIF
	477	END DO
	478
	479	ENDIF
	480	#if defined key_mpp_mpi
	481	l_north_nogather = .TRUE.
	482	#endif
	483	END SUBROUTINE nemo_northcomms
	484
	485
[6951]	486	!!======================================================================
	487	END MODULE nemogcm
	488

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

Download in other formats: