Context Navigation

source: tags/ORCHIDEE_4_1/ORCHIDEE/src_parallel/ioipsl_para.f90 @ 7852

Last change on this file since 7852 was 6504, checked in by josefine.ghattas, 4 years ago
Corrected errors introduced in [6190]. This resolves problems in ticket #661 for non reproducing the same results for 1 or several proc MPI.
Property svn:keywords set to `HeadURL Date Author Revision`
File size: 81.7 KB

Line
1	! ==============================================================================================================================
2	! MODULE : ioipls_para
3	!
4	! CONTACT : orchidee-help _at_ listes.ipsl.fr
5	!
6	! LICENCE : IPSL (2006)
7	! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
8	!
9	!>\BRIEF Overlap of IOIPSL functions for specific parallel use in ORCHIDEE.
10	!!
11	!!\n DESCRIPTION: This module contains interfaces for some IOIPSL subroutines adapted to be used in parallel mode by ORCHIDEE.
12	!!
13	!! Following interfaces are available :
14	!! - getin_p : Read a variable from run.def file. The master process will call getin in IOIPSL.
15	!! The same result will be known by all processes after the call.
16	!! The variable can be an integer, real, logical or character string. It can be a scalar or
17	!! have 1 or 2 dimensions except for character string which can only be scalar or have 1 dimension.
18	!! - restget_p : Read a variable from restart file. The master process will call the subroutine restget in IOIPSL.
19	!! The variable will be distributed on the local domain for each process.
20	!! The variable must be a real and can have 1, 2 or 3 dimensions. It can not be a scalar.
21	!! - restput_p : Write a variable to restart file. The master process will call the subroutine restput in IOIPSL.
22	!! The input variable must be given on the local domain for each process.
23	!! The variable must be a real and can have 1, 2 or 3 dimensions. It can not be a scalar.
24	!! - histwrite_p : Write a variable to history file. The master process will call the subroutine histwrite in IOIPSL.
25	!! The input variable must be given on the local domain for each process.
26	!! The variable must be a real and can have 1, 2 or 3 dimensions. It can not be a scalar.
27	!!
28	!! Note that these subroutines must be called by all MPI processes and all OMP thredds because they contain
29	!! all a MPI blocker function.
30	!!
31	!!
32	!!
33	!! RECENT CHANGE(S): None
34	!!
35	!! REFERENCES(S) : None
36	!!
37	!! SVN :
38	!! $HeadURL$
39	!! $Date$
40	!! $Revision$
41	!! \n
42	!_ ================================================================================================================================
43
44	MODULE ioipsl_para
45	USE ioipsl
46	USE mod_orchidee_para_var
47	USE mod_orchidee_transfert_para
48	USE constantes_var, ONLY: val_exp
49	!-
50	IMPLICIT NONE
51
52	INTEGER, SAVE :: orch_domain_id
53	!-
54	INTEGER :: orch_ipslout=6, orch_ilv_cur=0, orch_ilv_max=0
55	!$OMP THREADPRIVATE( orch_ipslout, orch_ilv_cur, orch_ilv_max )
56
57	PRIVATE :: restransfer_opp_r1d, restransfer_opp_r2d, restransfer_opp_r3d, &
58	restransfer_opp_r4d, restransfer_opp_r5d, restransfer_scal, &
59	ioget_var_is_scalar, rest_o_nb_dims
60
61	!-
62	!-
63	#include "src_parallel.h"
64	!-
65	!! ==============================================================================================================================
66	!! INTERFACE : getin_p
67	!!
68	!>\BRIEF interface to parallelize the call to getin in IOIPSL
69	!!
70	!! DESCRIPTION : get a variable from a text input file. Need to be call by all process
71	!!
72	!! \n
73	!_ ================================================================================================================================
74	INTERFACE getin_p
75	MODULE PROCEDURE getin_p_c,getin_p_c1, &
76	getin_p_i,getin_p_i1,getin_p_i2,&
77	getin_p_r,getin_p_r1,getin_p_r2,&
78	getin_p_l,getin_p_l1,getin_p_l2
79	END INTERFACE
80	!-
81	!! ==============================================================================================================================
82	!! INTERFACE : restput_p
83	!!
84	!>\BRIEF interface to parallelize the call to restput in IOIPSL
85	!!
86	!! DESCRIPTION : allows to re-index data onto the original grid of the restart file. Need to be call by all process
87	!!
88	!! \n
89	!_ ================================================================================================================================
90	INTERFACE restput_p
91	MODULE PROCEDURE &
92	restput_p_r3d, restput_p_r2d, restput_p_r1d, &
93	restput_p_opp_r5d, restput_p_opp_r4d, restput_p_opp_r3d, &
94	restput_p_opp_r2d, restput_p_opp_r1d, restput_p_nogrid_r1d, &
95	restput_p_nogrid_i_scal, restput_p_nogrid_r_scal, &
96	restput_p_opp_i1d, restput_p_opp_i2d, restput_p_opp_i3d, &
97	restput_p_opp_i4d, restput_p_opp_i5d
98	END INTERFACE
99	!-
100	!! ==============================================================================================================================
101	!! INTERFACE : restget_p
102	!!
103	!>\BRIEF interface to parallelize the call to restget in IOIPSL
104	!!
105	!! DESCRIPTION : Transform the data from the restart file onto the model grid.
106	!!
107	!! \n
108	!_ ================================================================================================================================
109	INTERFACE restget_p
110	MODULE PROCEDURE &
111	restget_p_r3d, restget_p_r2d, restget_p_r1d, &
112	restget_p_opp_r5d, restget_p_opp_r4d, restget_p_opp_r3d, &
113	restget_p_opp_r2d, restget_p_opp_r1d, restget_p_nogrid_r1d, &
114	restget_p_nogrid_r_scal, restget_p_nogrid_i_scal, &
115	restget_p_opp_i1d, restget_p_opp_i2d, restget_p_opp_i3d, &
116	restget_p_opp_i4d, restget_p_opp_i5d
117	END INTERFACE
118
119	!! ==============================================================================================================================
120	!! INTERFACE :
121	!!
122	!>\BRIEF
123	!!
124	!! DESCRIPTION :
125	!!
126	!! \n
127	!_ ================================================================================================================================
128
129	INTERFACE restransfer
130	MODULE PROCEDURE restransfer_scal, restransfer_var
131	END INTERFACE
132
133	!! ==============================================================================================================================
134	!! INTERFACE : histwrite_p
135	!!
136	!>\BRIEF interface to parallelize the call to histwrite in IOIPSL
137	!!
138	!! DESCRIPTION : give the data to the IOIPSL system (if we don't use XIOS). Need to be call by all process
139	!!
140	!! \n
141	!_ ================================================================================================================================
142
143	INTERFACE histwrite_p
144	MODULE PROCEDURE &
145	histwrite_r1d_p,histwrite_r2d_p,histwrite_r3d_p
146	END INTERFACE
147
148	!! ==============================================================================================================================
149	!! INTERFACE : ipslerr_p
150	!!
151	!>\BRIEF information subroutine for developpers
152	!!
153	!! DESCRIPTION : provide an information subroutine in 3 modes: debug, warn or error(stops)
154	!!
155	!! \n
156	!_ ================================================================================================================================
157
158	INTERFACE ipslerr_p
159	MODULE PROCEDURE &
160	ipslerr_p_str, ipslerr_p_int
161	END INTERFACE
162	CONTAINS
163
164
165	!! =============================================================================================================================
166	!! SUBROUTINE: Init_ioipsl_para
167	!!
168	!>\BRIEF call to IOIPSL routine : flio_dom_set
169	!!
170	!! DESCRIPTION: will sets up the domain activity of IOIPSL. Need to be call by all process
171	!!
172	!! \n
173	!_ ==============================================================================================================================
174
175	SUBROUTINE Init_ioipsl_para
176
177	IMPLICIT NONE
178
179	INTEGER,DIMENSION(2) :: ddid
180	INTEGER,DIMENSION(2) :: dsg
181	INTEGER,DIMENSION(2) :: dsl
182	INTEGER,DIMENSION(2) :: dpf
183	INTEGER,DIMENSION(2) :: dpl
184	INTEGER,DIMENSION(2) :: dhs
185	INTEGER,DIMENSION(2) :: dhe
186
187	IF (is_omp_root) THEN
188	ddid=(/ 1,2 /)
189	dsg=(/ iim_g, jjm_g /)
190	dsl=(/ iim_g, jj_nb /)
191	dpf=(/ 1,jj_begin /)
192	dpl=(/ iim_g, jj_end /)
193	dhs=(/ ii_begin-1,0 /)
194	if (mpi_rank==mpi_size-1) then
195	dhe=(/0,0/)
196	else
197	dhe=(/ iim_g-ii_end,0 /)
198	endif
199
200	call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
201	'APPLE',orch_domain_id)
202	ENDIF
203
204	END SUBROUTINE Init_ioipsl_para
205
206	!! =============================================================================================================================
207	!! SUBROUTINE: ioconf_setatt_p
208	!!
209	!>\BRIEF parallelisation of the call to IOIPSL routine ioconf_setatt
210	!!
211	!! DESCRIPTION: NONE
212	!!
213	!! \n
214	!_ ==============================================================================================================================
215	SUBROUTINE ioconf_setatt_p (attname,attvalue)
216	!---------------------------------------------------------------------
217	IMPLICIT NONE
218	!-
219	CHARACTER(LEN=*), INTENT(in) :: attname,attvalue
220	!---------------------------------------------------------------------
221
222	IF (is_root_prc) THEN
223	CALL ioconf_setatt(attname,attvalue)
224	ENDIF
225
226	END SUBROUTINE ioconf_setatt_p
227
228	!! =============================================================================================================================
229	!! SUBROUTINE: ipslnlf_p
230	!!
231	!>\BRIEF parallelisation of the call to IOIPSL routine ipslnlf
232	!!
233	!! DESCRIPTION: The "ipslnlf" routine allows to know and modify the current logical number for the messages.
234	!!
235	!! \n
236	!_ ==============================================================================================================================
237	SUBROUTINE ipslnlf_p (new_number,old_number)
238	!!--------------------------------------------------------------------
239	!! The "ipslnlf" routine allows to know and modify
240	!! the current logical number for the messages.
241	!!
242	!! SUBROUTINE ipslnlf (new_number,old_number)
243	!!
244	!! Optional INPUT argument
245	!!
246	!! (I) new_number : new logical number of the file
247	!!
248	!! Optional OUTPUT argument
249	!!
250	!! (I) old_number : current logical number of the file
251	!!--------------------------------------------------------------------
252	IMPLICIT NONE
253	!-
254	INTEGER,OPTIONAL,INTENT(IN) :: new_number
255	INTEGER,OPTIONAL,INTENT(OUT) :: old_number
256	!---------------------------------------------------------------------
257	IF (PRESENT(old_number)) THEN
258	#ifndef CPP_OMP
259	CALL ipslnlf(old_number=orch_ipslout)
260	#endif
261	old_number = orch_ipslout
262	ENDIF
263	IF (PRESENT(new_number)) THEN
264	orch_ipslout = new_number
265	#ifndef CPP_OMP
266	CALL ipslnlf(new_number=orch_ipslout)
267	#endif
268	ENDIF
269
270	END SUBROUTINE ipslnlf_p
271
272	!! =============================================================================================================================
273	!! SUBROUTINE: ipslerr_p_str
274	!!
275	!>\BRIEF allows to handle the messages to the user.
276	!!
277	!! DESCRIPTION: NONE
278	!!
279	!! \n
280	!_ ==============================================================================================================================
281	!===
282	SUBROUTINE ipslerr_p_str (plev,pcname,pstr1,pstr2,pstr3)
283	!---------------------------------------------------------------------
284	!! The "ipslerr_p_str" routine
285	!! allows to handle the messages to the user.
286	!!
287	!! parallel version of IOIPSL ipslerr
288	!!
289	!! INPUT
290	!!
291	!! plev : Category of message to be reported to the user
292	!! 1 = Note to the user
293	!! 2 = Warning to the user
294	!! 3 = Fatal error
295	!! pcname : Name of subroutine which has called ipslerr
296	!! pstr1
297	!! pstr2 : Strings containing the explanations to the user
298	!! pstr3
299	!---------------------------------------------------------------------
300
301	IMPLICIT NONE
302
303	#ifdef CPP_PARA
304	INCLUDE 'mpif.h'
305	#endif
306
307	INTEGER :: plev
308	CHARACTER(LEN=*) :: pcname,pstr1,pstr2,pstr3
309
310	CHARACTER(LEN=30),DIMENSION(3) :: pemsg = &
311	& (/ "NOTE TO THE USER FROM ROUTINE ", &
312	& "WARNING FROM ROUTINE ", &
313	& "FATAL ERROR FROM ROUTINE " /)
314	INTEGER :: ierr
315	!---------------------------------------------------------------------
316	IF ( (plev >= 1).AND.(plev <= 3) ) THEN
317	orch_ilv_cur = plev
318	orch_ilv_max = MAX(orch_ilv_max,plev)
319	WRITE(orch_ipslout,'(/,A," ",A)') TRIM(pemsg(plev)),TRIM(pcname)
320	WRITE(orch_ipslout,'(3(" --> ",A,/))') TRIM(pstr1),TRIM(pstr2),TRIM(pstr3)
321	ENDIF
322	IF (plev == 3) THEN
323	WRITE(orch_ipslout,'("Fatal error from ORCHIDEE. STOP in ipslerr_p with code")')
324	! Force to pring text output using FLUSH only if cpp flag CPP_FLUSH is set in arch-XXX.fcm
325	#ifdef CPP_FLUSH
326	CALL FLUSH(orch_ipslout)
327	#endif
328
329	#ifdef CPP_PARA
330	CALL MPI_ABORT(MPI_COMM_WORLD, 1, ierr)
331	#endif
332	STOP 1
333	ENDIF
334	!---------------------
335	END SUBROUTINE ipslerr_p_str
336
337	!! =============================================================================================================================
338	!! SUBROUTINE: ipslerr_p_int
339	!!
340	!>\BRIEF ipslerr_p_str wrapper to allow a int argument in the last position
341	!!
342	!! DESCRIPTION: NONE
343	!!
344	!! \n
345	!_ ==============================================================================================================================
346	!===
347	SUBROUTINE ipslerr_p_int (plev,pcname,pstr1,pstr2,pint3)
348	IMPLICIT NONE
349
350	INTEGER, INTENT(in) :: plev
351	CHARACTER(LEN=*), INTENT(in) :: pcname,pstr1,pstr2
352	INTEGER, INTENT(in) :: pint3
353
354	CHARACTER(LEN=30) :: tmp_str
355
356	WRITE(tmp_str, *) pint3
357	CALL ipslerr_p_str(plev, pcname, pstr1, pstr2, TRIM(tmp_str))
358
359	END SUBROUTINE ipslerr_p_int
360
361	!! =============================================================================================================================
362	!! SUBROUTINE: getin_p_c
363	!!
364	!>\BRIEF get a character variable in text input file
365	!!
366	!! DESCRIPTION: Need to be call by all process
367	!!
368	!! \n
369	!_ ==============================================================================================================================
370	SUBROUTINE getin_p_c(VarIn,VarOut)
371	IMPLICIT NONE
372	CHARACTER(LEN=*),INTENT(IN) :: VarIn
373	CHARACTER(LEN=*),INTENT(INOUT) :: VarOut
374
375	IF (is_root_prc) CALL getin(VarIn,VarOut)
376	CALL bcast(VarOut)
377	END SUBROUTINE getin_p_c
378
379	!! =============================================================================================================================
380	!! SUBROUTINE: getin_p_c1
381	!!
382	!>\BRIEF get a character 1D array in text input file
383	!!
384	!! DESCRIPTION: Need to be call by all process
385	!!
386	!! \n
387	!_ ==============================================================================================================================
388	SUBROUTINE getin_p_c1(VarIn,VarOut)
389	IMPLICIT NONE
390	CHARACTER(LEN=*),INTENT(IN) :: VarIn
391	CHARACTER(LEN=*),INTENT(INOUT) :: VarOut(:)
392
393	IF (is_root_prc) CALL getin(VarIn,VarOut)
394	CALL bcast(VarOut)
395	END SUBROUTINE getin_p_c1
396
397	!! =============================================================================================================================
398	!! SUBROUTINE: getin_p_i
399	!!
400	!>\BRIEF get an integer variable in text input file
401	!!
402	!! DESCRIPTION: Need to be call by all process
403	!!
404	!! \n
405	!_ ==============================================================================================================================
406	SUBROUTINE getin_p_i(VarIn,VarOut)
407	IMPLICIT NONE
408	CHARACTER(LEN=*),INTENT(IN) :: VarIn
409	INTEGER,INTENT(INOUT) :: VarOut
410
411	IF (is_root_prc) CALL getin(VarIn,VarOut)
412	CALL bcast(VarOut)
413	END SUBROUTINE getin_p_i
414
415	!! =============================================================================================================================
416	!! SUBROUTINE: getin_p_i1
417	!!
418	!>\BRIEF get an integer 1D array in text input file
419	!!
420	!! DESCRIPTION: Need to be call by all process
421	!!
422	!! \n
423	!_ ==============================================================================================================================
424	SUBROUTINE getin_p_i1(VarIn,VarOut)
425	IMPLICIT NONE
426	CHARACTER(LEN=*),INTENT(IN) :: VarIn
427	INTEGER,INTENT(INOUT) :: VarOut(:)
428
429	IF (is_root_prc) CALL getin(VarIn,VarOut)
430	CALL bcast(VarOut)
431	END SUBROUTINE getin_p_i1
432
433	!! =============================================================================================================================
434	!! SUBROUTINE: getin_p_i2
435	!!
436	!>\BRIEF get an integer 2D array in text input file
437	!!
438	!! DESCRIPTION: Need to be call by all process
439	!!
440	!! \n
441	!_ ==============================================================================================================================
442	SUBROUTINE getin_p_i2(VarIn,VarOut)
443	IMPLICIT NONE
444	CHARACTER(LEN=*),INTENT(IN) :: VarIn
445	INTEGER,INTENT(INOUT) :: VarOut(:,:)
446
447	IF (is_root_prc) CALL getin(VarIn,VarOut)
448	CALL bcast(VarOut)
449	END SUBROUTINE getin_p_i2
450
451	!! =============================================================================================================================
452	!! SUBROUTINE: getin_p_r
453	!!
454	!>\BRIEF get a float variable in text input file
455	!!
456	!! DESCRIPTION: Need to be call by all process
457	!!
458	!! \n
459	!_ ==============================================================================================================================
460	SUBROUTINE getin_p_r(VarIn,VarOut)
461	IMPLICIT NONE
462	CHARACTER(LEN=*),INTENT(IN) :: VarIn
463	REAL,INTENT(INOUT) :: VarOut
464
465	IF (is_root_prc) CALL getin(VarIn,VarOut)
466	CALL bcast(VarOut)
467	END SUBROUTINE getin_p_r
468
469	!! =============================================================================================================================
470	!! SUBROUTINE: getin_p_r1
471	!!
472	!>\BRIEF get a float 1D array in text input file
473	!!
474	!! DESCRIPTION: Need to be call by all process
475	!!
476	!! \n
477	!_ ==============================================================================================================================
478	SUBROUTINE getin_p_r1(VarIn,VarOut)
479	IMPLICIT NONE
480	CHARACTER(LEN=*),INTENT(IN) :: VarIn
481	REAL,INTENT(INOUT) :: VarOut(:)
482
483	IF (is_root_prc) CALL getin(VarIn,VarOut)
484	CALL bcast(VarOut)
485	END SUBROUTINE getin_p_r1
486
487	!! =============================================================================================================================
488	!! SUBROUTINE: getin_p_r2
489	!!
490	!>\BRIEF get a float 2D array in text input file
491	!!
492	!! DESCRIPTION: Need to be call by all process
493	!!
494	!! \n
495	!_ ==============================================================================================================================
496	SUBROUTINE getin_p_r2(VarIn,VarOut)
497	IMPLICIT NONE
498	CHARACTER(LEN=*),INTENT(IN) :: VarIn
499	REAL,INTENT(INOUT) :: VarOut(:,:)
500
501	IF (is_root_prc) CALL getin(VarIn,VarOut)
502	CALL bcast(VarOut)
503	END SUBROUTINE getin_p_r2
504
505
506	!! =============================================================================================================================
507	!! SUBROUTINE: getin_p_l
508	!!
509	!>\BRIEF get a logical variable in text input file
510	!!
511	!! DESCRIPTION: Need to be call by all process
512	!!
513	!! \n
514	!_ ==============================================================================================================================
515	SUBROUTINE getin_p_l(VarIn,VarOut)
516	IMPLICIT NONE
517	CHARACTER(LEN=*),INTENT(IN) :: VarIn
518	LOGICAL,INTENT(INOUT) :: VarOut
519
520	IF (is_root_prc) CALL getin(VarIn,VarOut)
521	CALL bcast(VarOut)
522	END SUBROUTINE getin_p_l
523
524	!! =============================================================================================================================
525	!! SUBROUTINE: getin_p_l1
526	!!
527	!>\BRIEF get a logical 1D array in text input file
528	!!
529	!! DESCRIPTION: Need to be call by all process
530	!!
531	!! \n
532	!_ ==============================================================================================================================
533	SUBROUTINE getin_p_l1(VarIn,VarOut)
534	IMPLICIT NONE
535	CHARACTER(LEN=*),INTENT(IN) :: VarIn
536	LOGICAL,INTENT(INOUT) :: VarOut(:)
537
538	IF (is_root_prc) CALL getin(VarIn,VarOut)
539	CALL bcast(VarOut)
540	END SUBROUTINE getin_p_l1
541
542	!! =============================================================================================================================
543	!! SUBROUTINE: getin_p_l2
544	!!
545	!>\BRIEF get a logical 2D array in text input file
546	!!
547	!! DESCRIPTION: Need to be call by all process
548	!!
549	!! \n
550	!_ ==============================================================================================================================
551	SUBROUTINE getin_p_l2(VarIn,VarOut)
552	IMPLICIT NONE
553	CHARACTER(LEN=*),INTENT(IN) :: VarIn
554	LOGICAL,INTENT(INOUT) :: VarOut(:,:)
555
556	IF (is_root_prc) CALL getin(VarIn,VarOut)
557	CALL bcast(VarOut)
558	END SUBROUTINE getin_p_l2
559	!-
560
561	!! =============================================================================================================================
562	!! SUBROUTINE: restget_p_opp_r1d
563	!!
564	!>\BRIEF Transform the data (real 1D) from the restart file onto the model grid with the operation MY_OPERATOR
565	!!
566	!! DESCRIPTION: do not use this function with non grid variable
567	!!
568	!! \n
569	!_ ==============================================================================================================================
570	SUBROUTINE restget_p_opp_r1d &
571	(fid, vname_q, iim, jjm, llm, itau, def_beha, &
572	var, MY_OPERATOR, nbindex, ijndex)
573	! DO NOT USE THIS FUNCTION WITH NON GRID VARIABLE !
574
575	USE grid, ONLY : grid_type, unstructured, ind_cell_glo
576	IMPLICIT NONE
577	!-
578	INTEGER :: fid
579	CHARACTER(LEN=*) :: vname_q
580	INTEGER :: iim, jjm, llm, itau
581	LOGICAL def_beha
582	REAL :: var(:)
583	CHARACTER(LEN=*) :: MY_OPERATOR
584	INTEGER :: nbindex, ijndex(nbindex)
585	!-----------------------------
586	REAL, ALLOCATABLE, DIMENSION(:) :: temp_g
587	INTEGER, ALLOCATABLE, DIMENSION(:) :: ind_cell_glo_glo
588
589	IF (is_root_prc) THEN
590	ALLOCATE( temp_g(iimjjmllm) )
591	ELSE
592	ALLOCATE( temp_g(1) )
593	ENDIF
594
595	IF (grid_type==unstructured) THEN
596
597	IF (is_root_prc) ALLOCATE(ind_cell_glo_glo(iim_g*jjm_g))
598	CALL gather_unindexed(ind_cell_glo,ind_cell_glo_glo)
599	IF (is_root_prc) CALL restget (fid, vname_q, iim, jjm, llm, itau, def_beha, &
600	temp_g, MY_OPERATOR, nbindex, ind_cell_glo_glo(ijndex(:)))
601
602	ELSE
603
604	IF (is_root_prc) CALL restget(fid, vname_q, iim, jjm, llm, itau, def_beha, &
605	temp_g, MY_OPERATOR, nbindex, ijndex)
606	ENDIF
607	CALL scatter(temp_g,var)
608	DEALLOCATE(temp_g)
609	END SUBROUTINE restget_p_opp_r1d
610
611	!! =============================================================================================================================
612	!! SUBROUTINE: restget_p_opp_r2d
613	!!
614	!>\BRIEF Transform the data (real 2D) from the restart file onto the model grid with the operation MY_OPERATOR
615	!!
616	!! DESCRIPTION: do not use this function with non grid variable. Need to be call by all process
617	!!
618	!! \n
619	!_ ==============================================================================================================================
620	SUBROUTINE restget_p_opp_r2d &
621	(fid, vname_q, iim, jjm, llm, itau, def_beha, &
622	var, MY_OPERATOR, nbindex, ijndex)
623
624	USE grid, ONLY : grid_type, unstructured, ind_cell_glo
625	IMPLICIT NONE
626	!-
627	INTEGER :: fid
628	CHARACTER(LEN=*) :: vname_q
629	INTEGER :: iim, jjm, llm, itau
630	LOGICAL def_beha
631	REAL :: var(:,:)
632	CHARACTER(LEN=*) :: MY_OPERATOR
633	INTEGER :: nbindex, ijndex(nbindex)
634	!-----------------------------
635	REAL, ALLOCATABLE, DIMENSION(:,:) :: temp_g
636	INTEGER, ALLOCATABLE, DIMENSION(:) :: ind_cell_glo_glo
637
638	IF (is_root_prc) THEN
639	ALLOCATE( temp_g(iim,jjm) )
640	ELSE
641	ALLOCATE( temp_g(1,1) )
642	ENDIF
643
644	IF (grid_type==unstructured) THEN
645	IF (is_root_prc) ALLOCATE(ind_cell_glo_glo(iim_g*jjm_g))
646	CALL gather_unindexed(ind_cell_glo,ind_cell_glo_glo)
647	IF (is_root_prc) CALL restget (fid, vname_q, iim, jjm, llm, itau, def_beha, &
648	temp_g, MY_OPERATOR, nbindex, ind_cell_glo_glo(ijndex(:)))
649
650	ELSE
651
652	IF (is_root_prc) CALL restget(fid, vname_q, iim, jjm, llm, itau, def_beha, &
653	temp_g, MY_OPERATOR, nbindex, ijndex)
654	ENDIF
655	CALL scatter(temp_g,var)
656	DEALLOCATE(temp_g)
657	END SUBROUTINE restget_p_opp_r2d
658
659	!! =============================================================================================================================
660	!! SUBROUTINE: restget_p_opp_r2d
661	!!
662	!>\BRIEF Transform the data (real 2D) from the restart file onto the model grid with the operation MY_OPERATOR
663	!!
664	!! DESCRIPTION: do not use this function with non grid variable. Need to be call by all process
665	!!
666	!! \n
667	!_ ==============================================================================================================================
668	SUBROUTINE restget_p_opp_r3d &
669	(fid, vname_q, iim, jjm, llm, itau, def_beha, &
670	var, MY_OPERATOR, nbindex, ijndex)
671	! DO NOT USE THIS FUNCTION WITH NON GRID VARIABLE !
672
673	USE grid, ONLY : grid_type, unstructured, ind_cell_glo
674	IMPLICIT NONE
675	!-
676	INTEGER :: fid
677	CHARACTER(LEN=*) :: vname_q
678	INTEGER :: iim, jjm, llm, itau
679	LOGICAL def_beha
680	REAL :: var(:,:,:)
681	CHARACTER(LEN=*) :: MY_OPERATOR
682	INTEGER :: nbindex, ijndex(nbindex)
683	!-----------------------------
684	REAL, ALLOCATABLE, DIMENSION(:,:,:) :: temp_g
685	INTEGER, ALLOCATABLE, DIMENSION(:) :: ind_cell_glo_glo
686
687	IF (is_root_prc) THEN
688	ALLOCATE( temp_g(iim,jjm,llm) )
689	ELSE
690	ALLOCATE( temp_g(1,1,1) )
691	ENDIF
692
693	IF (grid_type==unstructured) THEN
694	IF (is_root_prc) ALLOCATE(ind_cell_glo_glo(iim_g*jjm_g))
695	CALL gather_unindexed(ind_cell_glo,ind_cell_glo_glo)
696	IF (is_root_prc) CALL restget (fid, vname_q, iim, jjm, llm, itau, def_beha, &
697	temp_g, MY_OPERATOR, nbindex, ind_cell_glo_glo(ijndex(:)))
698
699	ELSE
700
701	IF (is_root_prc) THEN
702	CALL restget &
703	(fid, vname_q, iim, jjm, llm, itau, def_beha, &
704	temp_g, MY_OPERATOR, nbindex, ijndex)
705	ENDIF
706	ENDIF
707	CALL scatter(temp_g,var)
708	DEALLOCATE(temp_g)
709
710	END SUBROUTINE restget_p_opp_r3d
711
712	!! =============================================================================================================================
713	!! SUBROUTINE: restget_p_opp_r4d
714	!!
715	!>\BRIEF Transform the data (real 4D) from the restart file onto the model grid with the operation MY_OPERATOR
716	!!
717	!! DESCRIPTION: do not use this function with non grid variable. Need to be call by all process
718	!!
719	!! \n
720	!_ ==============================================================================================================================
721	SUBROUTINE restget_p_opp_r4d &
722	(fid, vname_q, iim, jjm, llm, zzm, itau, def_beha, &
723	var, MY_OPERATOR, nbindex, ijndex)
724	! DO NOT USE THIS FUNCTION WITH NON GRID VARIABLE !
725
726	USE grid, ONLY : grid_type, unstructured, ind_cell_glo
727	IMPLICIT NONE
728	!-
729	INTEGER :: fid
730	CHARACTER(LEN=*) :: vname_q
731	INTEGER :: iim, jjm, llm, zzm, itau
732	LOGICAL def_beha
733	REAL :: var(:,:,:,:)
734	CHARACTER(LEN=*) :: MY_OPERATOR
735	INTEGER :: nbindex, ijndex(nbindex)
736	!-----------------------------
737	REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: temp_g
738	INTEGER, ALLOCATABLE, DIMENSION(:) :: ind_cell_glo_glo
739
740	IF (is_root_prc) THEN
741	ALLOCATE( temp_g(iim,jjm,llm,zzm) )
742	ELSE
743	ALLOCATE( temp_g(1,1,1,1) )
744	ENDIF
745
746	IF (grid_type==unstructured) THEN
747	IF (is_root_prc) ALLOCATE(ind_cell_glo_glo(iim_g*jjm_g))
748	CALL gather_unindexed(ind_cell_glo,ind_cell_glo_glo)
749	IF (is_root_prc) CALL restget (fid, vname_q, iim, jjm, llm, zzm, itau, def_beha, &
750	temp_g, MY_OPERATOR, nbindex, ind_cell_glo_glo(ijndex(:)))
751
752	ELSE
753	IF (is_root_prc) THEN
754	CALL restget &
755	(fid, vname_q, iim, jjm, llm, zzm, itau, def_beha, &
756	temp_g, MY_OPERATOR, nbindex, ijndex)
757	ENDIF
758	ENDIF
759	CALL scatter(temp_g,var)
760	DEALLOCATE(temp_g)
761
762	END SUBROUTINE restget_p_opp_r4d
763
764	!! =============================================================================================================================
765	!! SUBROUTINE: restget_p_opp_r5d
766	!!
767	!>\BRIEF Transform the data (real 5D) from the restart file onto the model grid with the operation MY_OPERATOR
768	!!
769	!! DESCRIPTION: do not use this function with non grid variable. Need to be call by all process
770	!!
771	!! \n
772	!_ ==============================================================================================================================
773	SUBROUTINE restget_p_opp_r5d &
774	(fid, vname_q, iim, jjm, llm, zzm, wwm, itau, def_beha, &
775	var, MY_OPERATOR, nbindex, ijndex)
776	! DO NOT USE THIS FUNCTION WITH NON GRID VARIABLE !
777
778	USE grid, ONLY : grid_type, unstructured, ind_cell_glo
779	IMPLICIT NONE
780	!-
781	INTEGER :: fid
782	CHARACTER(LEN=*) :: vname_q
783	INTEGER :: iim, jjm, llm, zzm, wwm, itau
784	LOGICAL def_beha
785	REAL :: var(:,:,:,:,:)
786	CHARACTER(LEN=*) :: MY_OPERATOR
787	INTEGER :: nbindex, ijndex(nbindex)
788	!-----------------------------
789	REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:) :: temp_g
790	INTEGER, ALLOCATABLE, DIMENSION(:) :: ind_cell_glo_glo
791
792	IF (is_root_prc) THEN
793	ALLOCATE( temp_g(iim,jjm,llm,zzm,wwm) )
794	ELSE
795	ALLOCATE( temp_g(1,1,1,1,1) )
796	ENDIF
797
798	IF (grid_type==unstructured) THEN
799	IF (is_root_prc) ALLOCATE(ind_cell_glo_glo(iim_g*jjm_g))
800	CALL gather_unindexed(ind_cell_glo,ind_cell_glo_glo)
801	IF (is_root_prc) CALL restget (fid, vname_q, iim, jjm, llm, zzm, wwm, itau, def_beha, &
802	temp_g, MY_OPERATOR, nbindex, ind_cell_glo_glo(ijndex(:)))
803
804	ELSE
805	IF (is_root_prc) THEN
806	CALL restget &
807	(fid, vname_q, iim, jjm, llm, zzm, wwm, itau, def_beha, &
808	temp_g, MY_OPERATOR, nbindex, ijndex)
809	ENDIF
810	ENDIF
811	CALL scatter(temp_g,var)
812	DEALLOCATE(temp_g)
813
814	END SUBROUTINE restget_p_opp_r5d
815
816	!! =============================================================================================================================
817	!! SUBROUTINE: restget_p_opp_i1d
818	!!
819	!>\BRIEF Transform the data (integer 1D) from the restart file onto the model grid with the operation MY_OPERATOR
820	!!
821	!! DESCRIPTION: do not use this function with non grid variable. Need to be call by all process
822	!!
823	!! \n
824	!_ ==============================================================================================================================
825	SUBROUTINE restget_p_opp_i1d &
826	(fid, vname_q, iim, jjm, llm, itau, def_beha, &
827	var, MY_OPERATOR, nbindex, ijndex)
828	IMPLICIT NONE
829	!-
830	INTEGER :: fid
831	CHARACTER(LEN=*) :: vname_q
832	INTEGER :: iim, jjm, llm, itau
833	LOGICAL def_beha
834	INTEGER, INTENT(out) :: var(:)
835	CHARACTER(LEN=*) :: MY_OPERATOR
836	INTEGER :: nbindex, ijndex(nbindex)
837	!-----------------------------
838	REAL, ALLOCATABLE, DIMENSION(:) :: temp_g
839	INTEGER :: ier
840
841	ALLOCATE( temp_g(SIZE(var, DIM=1)), stat=ier )
842	IF (ier /= 0) CALL ipslerr_p(3, 'restget_p_opp_i1d', 'Memory allocation error', vname_q, '')
843
844	CALL restget_p &
845	(fid, vname_q, iim, jjm, llm, itau, def_beha, &
846	temp_g, MY_OPERATOR, nbindex, ijndex)
847	var = INT(temp_g, i_std)
848
849	DEALLOCATE(temp_g)
850	END SUBROUTINE restget_p_opp_i1d
851
852	!! =============================================================================================================================
853	!! SUBROUTINE: restget_p_opp_i2d
854	!!
855	!>\BRIEF Transform the data (integer 2D) from the restart file onto the model grid with the operation MY_OPERATOR
856	!!
857	!! DESCRIPTION: do not use this function with non grid variable. Need to be call by all process
858	!!
859	!! \n
860	!_ ==============================================================================================================================
861	SUBROUTINE restget_p_opp_i2d &
862	(fid, vname_q, iim, jjm, llm, itau, def_beha, &
863	var, MY_OPERATOR, nbindex, ijndex)
864	IMPLICIT NONE
865	!-
866	INTEGER :: fid
867	CHARACTER(LEN=*) :: vname_q
868	INTEGER :: iim, jjm, llm, itau
869	LOGICAL def_beha
870	INTEGER, INTENT(out) :: var(:,:)
871	CHARACTER(LEN=*) :: MY_OPERATOR
872	INTEGER :: nbindex, ijndex(nbindex)
873	!-----------------------------
874	REAL, ALLOCATABLE, DIMENSION(:,:) :: temp_g
875	INTEGER :: ier
876
877	ALLOCATE( temp_g(SIZE(var, DIM=1), SIZE(var, DIM=2)), stat=ier )
878	IF (ier /= 0) CALL ipslerr_p(3, 'restget_p_opp_i2d', 'Memory allocation error', vname_q, '')
879
880	CALL restget_p &
881	(fid, vname_q, iim, jjm, llm, itau, def_beha, &
882	temp_g, MY_OPERATOR, nbindex, ijndex)
883	var = INT(temp_g, i_std)
884
885	DEALLOCATE(temp_g)
886	END SUBROUTINE restget_p_opp_i2d
887
888	!! =============================================================================================================================
889	!! SUBROUTINE: restget_p_opp_i3d
890	!!
891	!>\BRIEF Transform the data (integer 3D) from the restart file onto the model grid with the operation MY_OPERATOR
892	!!
893	!! DESCRIPTION: do not use this function with non grid variable. Need to be call by all process
894	!!
895	!! \n
896	!_ ==============================================================================================================================
897	SUBROUTINE restget_p_opp_i3d &
898	(fid, vname_q, iim, jjm, llm, itau, def_beha, &
899	var, MY_OPERATOR, nbindex, ijndex)
900	IMPLICIT NONE
901	!-
902	INTEGER :: fid
903	CHARACTER(LEN=*) :: vname_q
904	INTEGER :: iim, jjm, llm, itau
905	LOGICAL def_beha
906	INTEGER, INTENT(out) :: var(:,:,:)
907	CHARACTER(LEN=*) :: MY_OPERATOR
908	INTEGER :: nbindex, ijndex(nbindex)
909	!-----------------------------
910	REAL, ALLOCATABLE, DIMENSION(:,:,:) :: temp_g
911	INTEGER :: ier
912
913	ALLOCATE( temp_g(SIZE(var, DIM=1), SIZE(var, DIM=2), SIZE(var, DIM=3)), stat=ier )
914	IF (ier /= 0) CALL ipslerr_p(3, 'restget_p_opp_i3d', 'Memory allocation error', vname_q, '')
915
916	CALL restget_p_opp_r3d &
917	(fid, vname_q, iim, jjm, llm, itau, def_beha, &
918	temp_g, MY_OPERATOR, nbindex, ijndex)
919	var = INT(temp_g, i_std)
920
921	DEALLOCATE(temp_g)
922	END SUBROUTINE restget_p_opp_i3d
923
924	!! =============================================================================================================================
925	!! SUBROUTINE: restget_p_opp_i4d
926	!!
927	!>\BRIEF Transform the data (integer 4D) from the restart file onto the model grid with the operation MY_OPERATOR
928	!!
929	!! DESCRIPTION: do not use this function with non grid variable. Need to be call by all process
930	!!
931	!! \n
932	!_ ==============================================================================================================================
933	SUBROUTINE restget_p_opp_i4d &
934	(fid, vname_q, iim, jjm, llm, mmm, itau, def_beha, &
935	var, MY_OPERATOR, nbindex, ijndex)
936	IMPLICIT NONE
937	!-
938	INTEGER :: fid
939	CHARACTER(LEN=*) :: vname_q
940	INTEGER :: iim, jjm, llm, mmm, itau
941	LOGICAL def_beha
942	INTEGER, INTENT(out) :: var(:,:,:,:)
943	CHARACTER(LEN=*) :: MY_OPERATOR
944	INTEGER :: nbindex, ijndex(nbindex)
945	!-----------------------------
946	REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: temp_g
947	INTEGER :: ier
948
949	ALLOCATE( temp_g(SIZE(var, DIM=1), SIZE(var, DIM=2), SIZE(var, DIM=3), SIZE(var, DIM=4)), stat=ier )
950	IF (ier /= 0) CALL ipslerr_p(3, 'restget_p_opp_i4d', 'Memory allocation error', vname_q, '')
951
952	CALL restget_p &
953	(fid, vname_q, iim, jjm, llm, mmm, itau, def_beha, &
954	temp_g, MY_OPERATOR, nbindex, ijndex)
955	var = INT(temp_g, i_std)
956
957	DEALLOCATE(temp_g)
958	END SUBROUTINE restget_p_opp_i4d
959
960	!! =============================================================================================================================
961	!! SUBROUTINE: restget_p_opp_i2d
962	!!
963	!>\BRIEF Transform the data (integer 5D) from the restart file onto the model grid with the operation MY_OPERATOR
964	!!
965	!! DESCRIPTION: do not use this function with non grid variable. Need to be call by all process
966	!!
967	!! \n
968	!_ ==============================================================================================================================
969	SUBROUTINE restget_p_opp_i5d &
970	(fid, vname_q, iim, jjm, llm, mmm, wwm, itau, def_beha, &
971	var, MY_OPERATOR, nbindex, ijndex)
972	IMPLICIT NONE
973	!-
974	INTEGER :: fid
975	CHARACTER(LEN=*) :: vname_q
976	INTEGER :: iim, jjm, llm, mmm, wwm, itau
977	LOGICAL def_beha
978	INTEGER, INTENT(out) :: var(:,:,:,:,:)
979	CHARACTER(LEN=*) :: MY_OPERATOR
980	INTEGER :: nbindex, ijndex(nbindex)
981	!-----------------------------
982	REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:) :: temp_g
983	INTEGER :: ier
984
985	ALLOCATE( temp_g(SIZE(var, DIM=1), SIZE(var, DIM=2), SIZE(var, DIM=3), SIZE(var, DIM=4), SIZE(var, DIM=5)), stat=ier )
986	IF (ier /= 0) CALL ipslerr_p(3, 'restget_p_opp_i5d', 'Memory allocation error', vname_q, '')
987
988	CALL restget_p &
989	(fid, vname_q, iim, jjm, llm, mmm, wwm, itau, def_beha, &
990	temp_g, MY_OPERATOR, nbindex, ijndex)
991	var = INT(temp_g, i_std)
992
993	DEALLOCATE(temp_g)
994	END SUBROUTINE restget_p_opp_i5d
995
996	!! =============================================================================================================================
997	!! SUBROUTINE: restget_p_r1d
998	!!
999	!>\BRIEF Transform the data (real 1D) from the restart file onto the model grid
1000	!!
1001	!! DESCRIPTION: do not use this function with non grid variable. Need to be call by all process
1002	!! \n
1003	!_ ==============================================================================================================================
1004	SUBROUTINE restget_p_r1d &
1005	(fid,vname_q,iim,jjm,llm,itau,def_beha,var)
1006	! DO NOT USE THIS FUNCTION WITH NON GRID VARIABLE !
1007	IMPLICIT NONE
1008	!-
1009	INTEGER :: fid
1010	CHARACTER(LEN=*) :: vname_q
1011	INTEGER :: iim, jjm, llm, itau
1012	LOGICAL :: def_beha
1013	REAL :: var(:)
1014	!-------------------------
1015	REAL, ALLOCATABLE, DIMENSION(:) :: temp_g
1016	LOGICAL :: is_in_restart
1017
1018	IF (is_root_prc) THEN
1019	ALLOCATE( temp_g(iimjjmllm) )
1020	ELSE
1021	ALLOCATE( temp_g(1) )
1022	ENDIF
1023
1024	IF (is_root_prc) THEN
1025	CALL restget &
1026	(fid,vname_q,iim,jjm,llm,itau,def_beha,temp_g)
1027
1028	! Test if the variable was found in the restart file by testing the default value val_exp.
1029	! This can not be done after the scatter2D_mpi because the local 2D domain is bigger than the true values and might contain uninitialized values.
1030	IF(ALL(temp_g == val_exp)) THEN
1031	is_in_restart=.FALSE.
1032	ELSE
1033	is_in_restart=.TRUE.
1034	END IF
1035	ENDIF
1036
1037	CALL bcast(is_in_restart)
1038	IF (is_in_restart) THEN
1039	! The variable was found in the restart file. Distribute it to all processes.
1040	CALL scatter2D_mpi(temp_g,var)
1041	ELSE
1042	! The variable was not found in the restart file.
1043	! Set the variable to val_exp so it can be tested outside the subroutine using IF (ALL(var==val_exp)).
1044	var=val_exp
1045	END IF
1046
1047	DEALLOCATE(temp_g)
1048
1049	END SUBROUTINE restget_p_r1d
1050
1051	!! =============================================================================================================================
1052	!! SUBROUTINE: restget_p_r2d
1053	!!
1054	!>\BRIEF Transform the data (real 2D) from the restart file onto the model grid
1055	!!
1056	!! DESCRIPTION: do not use this function with non grid variable. Need to be call by all process
1057	!! \n
1058	!_ ==============================================================================================================================
1059	SUBROUTINE restget_p_r2d &
1060	(fid,vname_q,iim,jjm,llm,itau,def_beha,var)
1061	IMPLICIT NONE
1062	!-
1063	INTEGER :: fid
1064	CHARACTER(LEN=*) :: vname_q
1065	INTEGER :: iim, jjm, llm, itau
1066	LOGICAL :: def_beha
1067	REAL :: var(:,:)
1068	!-------------------------
1069	REAL, ALLOCATABLE, DIMENSION(:,:) :: temp_g
1070	LOGICAL :: is_in_restart
1071
1072	IF (is_root_prc) THEN
1073	ALLOCATE( temp_g(iim,jjm) )
1074	ELSE
1075	ALLOCATE( temp_g(1,1) )
1076	ENDIF
1077	IF (is_root_prc) THEN
1078	CALL restget &
1079	(fid,vname_q,iim,jjm,llm,itau,def_beha,temp_g)
1080
1081	! Test if the variable was found in the restart file by testing the default value val_exp.
1082	! This can not be done after the scatter2D_mpi because the local 2D domain is bigger than the true values and might contain uninitialized values.
1083	IF(ALL(temp_g == val_exp)) THEN
1084	is_in_restart=.FALSE.
1085	ELSE
1086	is_in_restart=.TRUE.
1087	END IF
1088	ENDIF
1089
1090	CALL bcast(is_in_restart)
1091	IF (is_in_restart) THEN
1092	! The variable was found in the restart file. Distribute it to all processes.
1093	CALL scatter2D_mpi(temp_g,var)
1094	ELSE
1095	! The variable was not found in the restart file.
1096	! Set the variable to val_exp so it can be tested outside the subroutine using IF (ALL(var==val_exp)).
1097	var=val_exp
1098	END IF
1099
1100	DEALLOCATE(temp_g)
1101
1102	END SUBROUTINE restget_p_r2d
1103
1104	!! =============================================================================================================================
1105	!! SUBROUTINE: restget_p_r3d
1106	!!
1107	!>\BRIEF Transform the data (real 3D) from the restart file onto the model grid
1108	!!
1109	!! DESCRIPTION: do not use this function with non grid variable. Need to be call by all process
1110	!! \n
1111	!_ ==============================================================================================================================
1112	SUBROUTINE restget_p_r3d &
1113	(fid,vname_q,iim,jjm,llm,itau,def_beha,var)
1114	IMPLICIT NONE
1115	!-
1116	INTEGER :: fid
1117	CHARACTER(LEN=*) :: vname_q
1118	INTEGER :: iim, jjm, llm, itau
1119	LOGICAL def_beha
1120	REAL :: var(:,:,:)
1121	!-------------------------
1122	REAL, ALLOCATABLE, DIMENSION(:,:,:) :: temp_g
1123	LOGICAL :: is_in_restart
1124
1125	IF (is_root_prc) THEN
1126	ALLOCATE( temp_g(iim,jjm,llm) )
1127	ELSE
1128	ALLOCATE( temp_g(1,1,1) )
1129	ENDIF
1130
1131	IF (is_root_prc) THEN
1132	CALL restget &
1133	(fid,vname_q,iim,jjm,llm,itau,def_beha,temp_g)
1134
1135	! Test if the variable was found in the restart file by testing the default value val_exp.
1136	! This can not be done after the scatter2D_mpi because the local 2D domain is bigger than the true values and might contain uninitialized values.
1137	IF(ALL(temp_g == val_exp)) THEN
1138	is_in_restart=.FALSE.
1139	ELSE
1140	is_in_restart=.TRUE.
1141	END IF
1142	ENDIF
1143
1144	CALL bcast(is_in_restart)
1145	IF (is_in_restart) THEN
1146	! The variable was found in the restart file. Distribute it to all processes.
1147	CALL scatter2D_mpi(temp_g,var)
1148	ELSE
1149	! The variable was not found in the restart file.
1150	! Set the variable to val_exp so it can be tested outside the subroutine using IF (ALL(var==val_exp)).
1151	var=val_exp
1152	END IF
1153
1154	DEALLOCATE(temp_g)
1155
1156	END SUBROUTINE restget_p_r3d
1157
1158	!! =============================================================================================================================
1159	!! SUBROUTINE: restget_p_nogrid_r1d
1160	!!
1161	!>\BRIEF Transform the data (real 1D) from the restart file onto the model grid
1162	!!
1163	!! DESCRIPTION:
1164	!! \n
1165	!_ ==============================================================================================================================
1166	SUBROUTINE restget_p_nogrid_r1d &
1167	(fid,vname_q,itau,def_beha,def_val,var)
1168	!
1169	IMPLICIT NONE
1170	!-
1171	INTEGER, INTENT(in) :: fid
1172	CHARACTER(LEN=*), INTENT(in) :: vname_q
1173	INTEGER, INTENT(in) :: itau
1174	LOGICAL, INTENT(in) :: def_beha
1175	REAL, INTENT(in) :: def_val
1176	REAL, DIMENSION(:), INTENT(out) :: var
1177	!-------------------------
1178	IF (is_root_prc) THEN
1179	var = val_exp
1180	CALL restget (fid, vname_q, 1 ,1 , 1, itau, def_beha, var)
1181	IF(ALL(var == val_exp)) var = def_val
1182	ENDIF
1183	CALL bcast(var)
1184
1185	END SUBROUTINE restget_p_nogrid_r1d
1186
1187	!! =============================================================================================================================
1188	!! SUBROUTINE: restget_p_nogrid_r_scal
1189	!!
1190	!>\BRIEF Transform the data (real scalar) from the restart file onto the model grid
1191	!!
1192	!! DESCRIPTION:
1193	!! \n
1194	!_ ==============================================================================================================================
1195	SUBROUTINE restget_p_nogrid_r_scal &
1196	(fid,vname_q,itau,def_beha,def_val,var)
1197	!
1198	IMPLICIT NONE
1199	!-
1200	INTEGER, INTENT(in) :: fid
1201	CHARACTER(LEN=*), INTENT(in) :: vname_q
1202	INTEGER, INTENT(in) :: itau
1203	LOGICAL, INTENT(in) :: def_beha
1204	REAL, INTENT(in) :: def_val
1205	REAL, INTENT(out) :: var
1206	!-------------------------
1207	REAL, DIMENSION(1) :: tmp
1208
1209	tmp(1) = var
1210	IF (is_root_prc) THEN
1211	var = val_exp
1212	CALL restget (fid, vname_q, 1 ,1 , 1, itau, def_beha, tmp)
1213	var = tmp(1)
1214	IF(var == val_exp) var = def_val
1215	ENDIF
1216	CALL bcast(var)
1217
1218	END SUBROUTINE restget_p_nogrid_r_scal
1219
1220	!! =============================================================================================================================
1221	!! SUBROUTINE: restget_p_nogrid_i_scal
1222	!!
1223	!>\BRIEF Transform the data (integer scalar) from the restart file onto the model grid
1224	!!
1225	!! DESCRIPTION:
1226	!! \n
1227	!_ ==============================================================================================================================
1228	SUBROUTINE restget_p_nogrid_i_scal &
1229	(fid,vname_q,itau,def_beha,def_val,varint)
1230	!
1231	IMPLICIT NONE
1232	!-
1233	INTEGER, INTENT(in) :: fid
1234	CHARACTER(LEN=*), INTENT(in) :: vname_q
1235	INTEGER, INTENT(in) :: itau
1236	LOGICAL, INTENT(in) :: def_beha
1237	REAL, INTENT(in) :: def_val
1238	INTEGER, INTENT(out) :: varint
1239	!-------------------------
1240	REAL :: tmp
1241
1242	CALL restget_p_nogrid_r_scal(fid, vname_q, itau, def_beha, def_val, tmp)
1243	varint = INT(tmp)
1244	END SUBROUTINE restget_p_nogrid_i_scal
1245
1246	!! =============================================================================================================================
1247	!! SUBROUTINE: restput_p_opp_r1d
1248	!!
1249	!>\BRIEF allows to re-index data (real 1D) onto the original grid of the restart file with the operation MY_OPERATOR
1250	!!
1251	!! DESCRIPTION: Need to be call by all process
1252	!! \n
1253	!_ ==============================================================================================================================
1254	SUBROUTINE restput_p_opp_r1d &
1255	(fid, vname_q, iim, jjm, llm, itau, var, MY_OPERATOR, nbindex, ijndex)
1256
1257	USE grid, ONLY : grid_type, unstructured, ind_cell_glo
1258	IMPLICIT NONE
1259	!-
1260	INTEGER :: fid
1261	CHARACTER(LEN=*) :: vname_q
1262	INTEGER :: iim, jjm, llm, itau
1263	REAL :: var(:)
1264	CHARACTER(LEN=*) :: MY_OPERATOR
1265	INTEGER :: nbindex, ijndex(nbindex)
1266	!-----------------------------
1267	REAL, ALLOCATABLE, DIMENSION(:) :: temp_g
1268	INTEGER, ALLOCATABLE, DIMENSION(:) :: ind_cell_glo_glo
1269
1270	IF (is_root_prc) THEN
1271	ALLOCATE( temp_g(iimjjmllm) )
1272	ELSE
1273	ALLOCATE ( temp_g(1) )
1274	ENDIF
1275
1276	CALL gather(var,temp_g)
1277
1278	IF (grid_type==unstructured) THEN
1279	IF (is_root_prc) ALLOCATE(ind_cell_glo_glo(iim_g*jjm_g))
1280	CALL gather_unindexed(ind_cell_glo,ind_cell_glo_glo)
1281	IF (is_root_prc) CALL restput(fid, vname_q, iim, jjm, llm, itau, temp_g, MY_OPERATOR, &
1282	nbindex, ind_cell_glo_glo(ijndex(:)))
1283	ELSE
1284	IF (is_root_prc) CALL restput &
1285	(fid, vname_q, iim, jjm, llm, itau, temp_g, MY_OPERATOR, nbindex, ijndex)
1286	ENDIF
1287
1288	DEALLOCATE( temp_g )
1289
1290	END SUBROUTINE restput_p_opp_r1d
1291
1292	!! =============================================================================================================================
1293	!! SUBROUTINE: restput_p_opp_r2d
1294	!!
1295	!>\BRIEF allows to re-index data (real 2D) onto the original grid of the restart file with the operation MY_OPERATOR
1296	!!
1297	!! DESCRIPTION: Need to be call by all process
1298	!! \n
1299	!_ ==============================================================================================================================
1300	SUBROUTINE restput_p_opp_r2d &
1301	(fid, vname_q, iim, jjm, llm, itau, var, MY_OPERATOR, nbindex, ijndex)
1302
1303	USE grid, ONLY : grid_type, unstructured, ind_cell_glo
1304	IMPLICIT NONE
1305	!-
1306	INTEGER :: fid
1307	CHARACTER(LEN=*) :: vname_q
1308	INTEGER :: iim, jjm, llm, itau
1309	REAL :: var(:,:)
1310	CHARACTER(LEN=*) :: MY_OPERATOR
1311	INTEGER :: nbindex, ijndex(nbindex)
1312	!-----------------------------
1313	REAL, ALLOCATABLE, DIMENSION(:,:) :: temp_g
1314	INTEGER, ALLOCATABLE, DIMENSION(:) :: ind_cell_glo_glo
1315
1316	IF (is_root_prc) THEN
1317	ALLOCATE( temp_g(iim,jjm) )
1318	ELSE
1319	ALLOCATE( temp_g(1,1) )
1320	ENDIF
1321
1322	CALL gather(var,temp_g)
1323	IF (grid_type==unstructured) THEN
1324	IF (is_root_prc) ALLOCATE(ind_cell_glo_glo(iim_g*jjm_g))
1325	CALL gather_unindexed(ind_cell_glo,ind_cell_glo_glo)
1326	IF (is_root_prc) CALL restput(fid, vname_q, iim, jjm, llm, itau, temp_g, MY_OPERATOR, &
1327	nbindex, ind_cell_glo_glo(ijndex(:)))
1328	ELSE
1329	IF (is_root_prc) CALL restput &
1330	(fid, vname_q, iim, jjm, llm, itau, temp_g, MY_OPERATOR, nbindex, ijndex)
1331	ENDIF
1332	DEALLOCATE( temp_g )
1333
1334	END SUBROUTINE restput_p_opp_r2d
1335
1336	!! =============================================================================================================================
1337	!! SUBROUTINE: restput_p_opp_r3d
1338	!!
1339	!>\BRIEF allows to re-index data (real 3D) onto the original grid of the restart file with the operation MY_OPERATOR
1340	!!
1341	!! DESCRIPTION: Need to be call by all process
1342	!! \n
1343	!_ ==============================================================================================================================
1344	SUBROUTINE restput_p_opp_r3d &
1345	(fid, vname_q, iim, jjm, llm, itau, var, MY_OPERATOR, nbindex, ijndex)
1346
1347	USE grid, ONLY : grid_type, unstructured, ind_cell_glo
1348	IMPLICIT NONE
1349	!-
1350	INTEGER :: fid
1351	CHARACTER(LEN=*) :: vname_q
1352	INTEGER :: iim, jjm, llm, itau
1353	REAL :: var(:,:,:)
1354	CHARACTER(LEN=*) :: MY_OPERATOR
1355	INTEGER :: nbindex, ijndex(nbindex)
1356	!-----------------------------
1357	REAL, ALLOCATABLE, DIMENSION(:,:,:) :: temp_g
1358	INTEGER, ALLOCATABLE, DIMENSION(:) :: ind_cell_glo_glo
1359
1360	IF (is_root_prc) THEN
1361	ALLOCATE( temp_g(iim,jjm,llm) )
1362	ELSE
1363	ALLOCATE( temp_g(1,1,1) )
1364	ENDIF
1365
1366	CALL gather(var,temp_g)
1367	IF (grid_type==unstructured) THEN
1368	IF (is_root_prc) ALLOCATE(ind_cell_glo_glo(iim_g*jjm_g))
1369	CALL gather_unindexed(ind_cell_glo,ind_cell_glo_glo)
1370	IF (is_root_prc) CALL restput(fid, vname_q, iim, jjm, llm, itau, temp_g, MY_OPERATOR, &
1371	nbindex, ind_cell_glo_glo(ijndex(:)))
1372	ELSE
1373	IF (is_root_prc) THEN
1374	CALL restput &
1375	(fid, vname_q, iim, jjm, llm, itau, temp_g, MY_OPERATOR, nbindex, ijndex)
1376	ENDIF
1377	ENDIF
1378	DEALLOCATE( temp_g )
1379
1380
1381	END SUBROUTINE restput_p_opp_r3d
1382
1383	!! =============================================================================================================================
1384	!! SUBROUTINE: restput_p_opp_r4d
1385	!!
1386	!>\BRIEF allows to re-index data (real 4D) onto the original grid of the restart file with the operation MY_OPERATOR
1387	!!
1388	!! DESCRIPTION: Need to be call by all process
1389	!! \n
1390	!_ ==============================================================================================================================
1391	SUBROUTINE restput_p_opp_r4d &
1392	(fid, vname_q, iim, jjm, llm, zzm, itau, var, MY_OPERATOR, nbindex, ijndex)
1393
1394	USE grid, ONLY : grid_type, unstructured, ind_cell_glo
1395	IMPLICIT NONE
1396	!-
1397	INTEGER :: fid
1398	CHARACTER(LEN=*) :: vname_q
1399	INTEGER :: iim, jjm, llm, zzm, itau
1400	REAL :: var(:,:,:,:)
1401	CHARACTER(LEN=*) :: MY_OPERATOR
1402	INTEGER :: nbindex, ijndex(nbindex)
1403	!-----------------------------
1404	REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: temp_g
1405	INTEGER, ALLOCATABLE, DIMENSION(:) :: ind_cell_glo_glo
1406
1407	IF (is_root_prc) THEN
1408	ALLOCATE( temp_g(iim,jjm,llm,zzm) )
1409	ELSE
1410	ALLOCATE( temp_g(1,1,1,1) )
1411	ENDIF
1412
1413	CALL gather(var,temp_g)
1414	IF (grid_type==unstructured) THEN
1415	IF (is_root_prc) ALLOCATE(ind_cell_glo_glo(iim_g*jjm_g))
1416	CALL gather_unindexed(ind_cell_glo,ind_cell_glo_glo)
1417	IF (is_root_prc) CALL restput(fid, vname_q, iim, jjm, llm, zzm, itau, temp_g, MY_OPERATOR, &
1418	nbindex, ind_cell_glo_glo(ijndex(:)))
1419	ELSE
1420	IF (is_root_prc) THEN
1421	CALL restput &
1422	(fid, vname_q, iim, jjm, llm, zzm, itau, &
1423	temp_g, MY_OPERATOR, nbindex, ijndex)
1424	ENDIF
1425	ENDIF
1426	DEALLOCATE( temp_g )
1427
1428
1429	END SUBROUTINE restput_p_opp_r4d
1430
1431	!! =============================================================================================================================
1432	!! SUBROUTINE: restput_p_opp_r5d
1433	!!
1434	!>\BRIEF allows to re-index data (real 5D) onto the original grid of the restart file with the operation MY_OPERATOR
1435	!!
1436	!! DESCRIPTION: Need to be call by all process
1437	!! \n
1438	!_ ==============================================================================================================================
1439	SUBROUTINE restput_p_opp_r5d &
1440	(fid, vname_q, iim, jjm, llm, zzm, wwm, itau, var, MY_OPERATOR, nbindex, ijndex)
1441
1442	USE grid, ONLY : grid_type, unstructured, ind_cell_glo
1443	IMPLICIT NONE
1444	!-
1445	INTEGER :: fid
1446	CHARACTER(LEN=*) :: vname_q
1447	INTEGER :: iim, jjm, llm, zzm, wwm, itau
1448	REAL :: var(:,:,:,:,:)
1449	CHARACTER(LEN=*) :: MY_OPERATOR
1450	INTEGER :: nbindex, ijndex(nbindex)
1451	!-----------------------------
1452	REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:) :: temp_g
1453	INTEGER, ALLOCATABLE, DIMENSION(:) :: ind_cell_glo_glo
1454
1455	IF (is_root_prc) THEN
1456	ALLOCATE( temp_g(iim,jjm,llm,zzm,wwm) )
1457	ELSE
1458	ALLOCATE( temp_g(1,1,1,1,1) )
1459	ENDIF
1460
1461	CALL gather(var,temp_g)
1462	IF (grid_type==unstructured) THEN
1463	IF (is_root_prc) ALLOCATE(ind_cell_glo_glo(iim_g*jjm_g))
1464	CALL gather_unindexed(ind_cell_glo,ind_cell_glo_glo)
1465	IF (is_root_prc) CALL restput(fid, vname_q, iim, jjm, llm, zzm, wwm, itau, temp_g, MY_OPERATOR, &
1466	nbindex, ind_cell_glo_glo(ijndex(:)))
1467	ELSE
1468	IF (is_root_prc) THEN
1469	CALL restput &
1470	(fid, vname_q, iim, jjm, llm, zzm, wwm, itau, &
1471	temp_g, MY_OPERATOR, nbindex, ijndex)
1472	ENDIF
1473	ENDIF
1474	DEALLOCATE( temp_g )
1475
1476
1477	END SUBROUTINE restput_p_opp_r5d
1478
1479	!! =============================================================================================================================
1480	!! SUBROUTINE: restput_p_opp_i1d
1481	!!
1482	!>\BRIEF allows to re-index data (integer 2D) onto the original grid of the restart file with the operation MY_OPERATOR
1483	!!
1484	!! DESCRIPTION: Need to be call by all process
1485	!! \n
1486	!_ ==============================================================================================================================
1487	SUBROUTINE restput_p_opp_i1d &
1488	(fid, vname_q, iim, jjm, llm, itau, var, MY_OPERATOR, nbindex, ijndex)
1489	IMPLICIT NONE
1490	!-
1491	INTEGER :: fid
1492	CHARACTER(LEN=*) :: vname_q
1493	INTEGER :: iim, jjm, llm, itau
1494	INTEGER :: var(:)
1495	CHARACTER(LEN=*) :: MY_OPERATOR
1496	INTEGER :: nbindex, ijndex(nbindex)
1497	!-----------------------------
1498	REAL, ALLOCATABLE, DIMENSION(:) :: temp_g
1499	INTEGER :: ier
1500
1501	ALLOCATE( temp_g(SIZE(var, DIM=1)), stat=ier)
1502	IF (ier /= 0) CALL ipslerr_p(3, 'restput_p_opp_i1d', 'Allocation memory error ', vname_q, '')
1503
1504	temp_g = REAL(var, r_std)
1505	CALL restput_p &
1506	(fid, vname_q, iim, jjm, llm, itau, temp_g, MY_OPERATOR, nbindex, ijndex)
1507
1508	DEALLOCATE( temp_g )
1509
1510	END SUBROUTINE restput_p_opp_i1d
1511
1512	!! =============================================================================================================================
1513	!! SUBROUTINE: restput_p_opp_i2d
1514	!!
1515	!>\BRIEF allows to re-index data (integer 2D) onto the original grid of the restart file with the operation MY_OPERATOR
1516	!!
1517	!! DESCRIPTION: Need to be call by all process
1518	!! \n
1519	!_ ==============================================================================================================================
1520	SUBROUTINE restput_p_opp_i2d &
1521	(fid, vname_q, iim, jjm, llm, itau, var, MY_OPERATOR, nbindex, ijndex)
1522	IMPLICIT NONE
1523	!-
1524	INTEGER :: fid
1525	CHARACTER(LEN=*) :: vname_q
1526	INTEGER :: iim, jjm, llm, itau
1527	INTEGER :: var(:,:)
1528	CHARACTER(LEN=*) :: MY_OPERATOR
1529	INTEGER :: nbindex, ijndex(nbindex)
1530	!-----------------------------
1531	REAL, ALLOCATABLE, DIMENSION(:,:) :: temp_g
1532	INTEGER :: ier
1533
1534	ALLOCATE( temp_g(SIZE(var, DIM=1), SIZE(var, DIM=2)), stat=ier)
1535	IF (ier /= 0) CALL ipslerr_p(3, 'restput_p_opp_i2d', 'Allocation memory error', vname_q, '')
1536
1537	temp_g = REAL(var, r_std)
1538	CALL restput_p &
1539	(fid, vname_q, iim, jjm, llm, itau, temp_g, MY_OPERATOR, nbindex, ijndex)
1540
1541	DEALLOCATE( temp_g )
1542
1543	END SUBROUTINE restput_p_opp_i2d
1544
1545	!! =============================================================================================================================
1546	!! SUBROUTINE: restput_p_opp_i3d
1547	!!
1548	!>\BRIEF allows to re-index data (integer 3D) onto the original grid of the restart file with the operation MY_OPERATOR
1549	!!
1550	!! DESCRIPTION: Need to be call by all process
1551	!! \n
1552	!_ ==============================================================================================================================
1553	SUBROUTINE restput_p_opp_i3d &
1554	(fid, vname_q, iim, jjm, llm, itau, var, MY_OPERATOR, nbindex, ijndex)
1555	IMPLICIT NONE
1556	!-
1557	INTEGER :: fid
1558	CHARACTER(LEN=*) :: vname_q
1559	INTEGER :: iim, jjm, llm, itau
1560	INTEGER :: var(:,:,:)
1561	CHARACTER(LEN=*) :: MY_OPERATOR
1562	INTEGER :: nbindex, ijndex(nbindex)
1563	!-----------------------------
1564	REAL, ALLOCATABLE, DIMENSION(:,:,:) :: temp_g
1565	INTEGER :: ier
1566
1567	ALLOCATE( temp_g(SIZE(var, DIM=1), SIZE(var, DIM=2), SIZE(var, DIM=3)), stat=ier)
1568	IF (ier /= 0) CALL ipslerr_p(3, 'restput_p_opp_i2d', 'Allocation memory error', vname_q, '')
1569
1570	temp_g = REAL(var, r_std)
1571	CALL restput_p_opp_r3d &
1572	(fid, vname_q, iim, jjm, llm, itau, temp_g, MY_OPERATOR, nbindex, ijndex)
1573
1574	DEALLOCATE( temp_g )
1575
1576	END SUBROUTINE restput_p_opp_i3d
1577
1578	!! =============================================================================================================================
1579	!! SUBROUTINE: restput_p_opp_i4d
1580	!!
1581	!>\BRIEF allows to re-index data (integer 4D) onto the original grid of the restart file with the operation MY_OPERATOR
1582	!!
1583	!! DESCRIPTION: Need to be call by all process
1584	!! \n
1585	!_ ==============================================================================================================================
1586	SUBROUTINE restput_p_opp_i4d &
1587	(fid, vname_q, iim, jjm, llm, mmm, itau, var, MY_OPERATOR, nbindex, ijndex)
1588	IMPLICIT NONE
1589	!-
1590	INTEGER :: fid
1591	CHARACTER(LEN=*) :: vname_q
1592	INTEGER :: iim, jjm, llm, mmm, itau
1593	INTEGER :: var(:,:,:,:)
1594	CHARACTER(LEN=*) :: MY_OPERATOR
1595	INTEGER :: nbindex, ijndex(nbindex)
1596	!-----------------------------
1597	REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: temp_g
1598	INTEGER :: ier
1599
1600	ALLOCATE( temp_g(SIZE(var, DIM=1), SIZE(var, DIM=2), SIZE(var, DIM=3), SIZE(var, DIM=4)), stat=ier)
1601	IF (ier /= 0) CALL ipslerr_p(3, 'restput_p_opp_i4d', 'Allocation memory error', vname_q, '')
1602
1603	temp_g = REAL(var, r_std)
1604	CALL restput_p &
1605	(fid, vname_q, iim, jjm, llm, mmm, itau, temp_g, MY_OPERATOR, nbindex, ijndex)
1606
1607	DEALLOCATE( temp_g )
1608
1609	END SUBROUTINE restput_p_opp_i4d
1610
1611	!! =============================================================================================================================
1612	!! SUBROUTINE: restput_p_opp_i5d
1613	!!
1614	!>\BRIEF allows to re-index data (integer 5D) onto the original grid of the restart file with the operation MY_OPERATOR
1615	!!
1616	!! DESCRIPTION: Need to be call by all process
1617	!! \n
1618	!_ ==============================================================================================================================
1619	SUBROUTINE restput_p_opp_i5d &
1620	(fid, vname_q, iim, jjm, llm, mmm, zzm, itau, var, MY_OPERATOR, nbindex, ijndex)
1621	IMPLICIT NONE
1622	!-
1623	INTEGER :: fid
1624	CHARACTER(LEN=*) :: vname_q
1625	INTEGER :: iim, jjm, llm, mmm, zzm, itau
1626	INTEGER :: var(:,:,:,:,:)
1627	CHARACTER(LEN=*) :: MY_OPERATOR
1628	INTEGER :: nbindex, ijndex(nbindex)
1629	!-----------------------------
1630	REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:) :: temp_g
1631	INTEGER :: ier
1632
1633	ALLOCATE( temp_g(SIZE(var, DIM=1), SIZE(var, DIM=2), SIZE(var, DIM=3), &
1634	SIZE(var, DIM=4), SIZE(var, DIM=5)), stat=ier)
1635	IF (ier /= 0) CALL ipslerr_p(3, 'restput_p_opp_i5d', 'Allocation memory error', vname_q, '')
1636
1637	temp_g = REAL(var, r_std)
1638	CALL restput_p &
1639	(fid, vname_q, iim, jjm, llm, mmm, zzm, itau, temp_g, MY_OPERATOR, nbindex, ijndex)
1640
1641	DEALLOCATE( temp_g )
1642
1643	END SUBROUTINE restput_p_opp_i5d
1644
1645	!! =============================================================================================================================
1646	!! SUBROUTINE: restput_p_r1d
1647	!!
1648	!>\BRIEF allows to re-index data (real 1D) onto the original grid of the restart file
1649	!!
1650	!! DESCRIPTION: Need to be call by all process
1651	!!
1652	!! \n
1653	!_ ==============================================================================================================================
1654	SUBROUTINE restput_p_r1d (fid,vname_q,iim,jjm,llm,itau,var)
1655	IMPLICIT NONE
1656	!-
1657	INTEGER :: fid
1658	CHARACTER(LEN=*) :: vname_q
1659	INTEGER :: iim, jjm, llm, itau
1660	REAL :: var(:)
1661	!-----------------------------
1662	REAL, ALLOCATABLE, DIMENSION(:) :: temp_g
1663
1664	IF (is_root_prc) THEN
1665	ALLOCATE( temp_g(iimjjmllm) )
1666	ELSE
1667	ALLOCATE( temp_g(1) )
1668	ENDIF
1669
1670	CALL gather2D_mpi(var,temp_g)
1671	IF (is_root_prc) THEN
1672	CALL restput (fid,vname_q,iim,jjm,llm,itau,temp_g)
1673	ENDIF
1674	DEALLOCATE( temp_g )
1675
1676	END SUBROUTINE restput_p_r1d
1677
1678	!! =============================================================================================================================
1679	!! SUBROUTINE: restput_p_r2d
1680	!!
1681	!>\BRIEF allows to re-index data (real 2D) onto the original grid of the restart file
1682	!!
1683	!! DESCRIPTION: Need to be call by all process
1684	!!
1685	!! \n
1686	!_ ==============================================================================================================================
1687	SUBROUTINE restput_p_r2d (fid,vname_q,iim,jjm,llm,itau,var)
1688	IMPLICIT NONE
1689	!-
1690	INTEGER :: fid
1691	CHARACTER(LEN=*) :: vname_q
1692	INTEGER :: iim, jjm, llm, itau
1693	REAL :: var(:,:)
1694	!-------------------------
1695	REAL, ALLOCATABLE, DIMENSION(:,:) :: temp_g
1696
1697	IF (is_root_prc) THEN
1698	ALLOCATE( temp_g(iim,jjm) )
1699	ELSE
1700	ALLOCATE( temp_g(1,1) )
1701	ENDIF
1702
1703	CALL gather2D_mpi(var,temp_g)
1704	IF (is_root_prc) THEN
1705	CALL restput (fid,vname_q,iim,jjm,llm,itau,temp_g)
1706	ENDIF
1707	DEALLOCATE( temp_g )
1708
1709	END SUBROUTINE restput_p_r2d
1710
1711	!! =============================================================================================================================
1712	!! SUBROUTINE: restput_p_nogrid_r1d
1713	!!
1714	!>\BRIEF save reald 1D array (non-grid) data into the restart file
1715	!!
1716	!! DESCRIPTION: Need to be call by all process
1717	!!
1718	!! \n
1719	!_ ==============================================================================================================================
1720	SUBROUTINE restput_p_nogrid_r1d (fid,vname_q,itau,var)
1721	IMPLICIT NONE
1722	!-
1723	INTEGER :: fid
1724	CHARACTER(LEN=*) :: vname_q
1725	INTEGER :: itau
1726	REAL,DIMENSION(:) :: var
1727	!-----------------------------
1728
1729	IF (is_root_prc) THEN
1730	CALL restput (fid, vname_q, 1, 1, 1, itau, var)
1731	ENDIF
1732
1733	END SUBROUTINE restput_p_nogrid_r1d
1734
1735	!! =============================================================================================================================
1736	!! SUBROUTINE: restput_p_r3d
1737	!!
1738	!>\BRIEF allows to re-index data (real 3D) onto the original grid of the restart file
1739	!!
1740	!! DESCRIPTION: Need to be call by all process
1741	!!
1742	!! \n
1743	!_ ==============================================================================================================================
1744	SUBROUTINE restput_p_r3d (fid,vname_q,iim,jjm,llm,itau,var)
1745	IMPLICIT NONE
1746	!-
1747	INTEGER :: fid
1748	CHARACTER(LEN=*) :: vname_q
1749	INTEGER :: iim, jjm, llm, itau
1750	REAL :: var(:,:,:)
1751	!-------------------------
1752	REAL, ALLOCATABLE, DIMENSION(:,:,:) :: temp_g
1753
1754	IF (is_root_prc) THEN
1755	ALLOCATE( temp_g(iim,jjm,llm) )
1756	ELSE
1757	ALLOCATE( temp_g(1,1,1) )
1758	ENDIF
1759
1760	CALL gather2D_mpi(var,temp_g)
1761	IF (is_root_prc) THEN
1762	CALL restput (fid,vname_q,iim,jjm,llm,itau,temp_g)
1763	ENDIF
1764	DEALLOCATE( temp_g )
1765
1766	END SUBROUTINE restput_p_r3d
1767
1768	!! =============================================================================================================================
1769	!! SUBROUTINE: restput_p_nogrid_r_scal
1770	!!
1771	!>\BRIEF save real scalar (non-grid) data into the restart file
1772	!!
1773	!! DESCRIPTION: Need to be call by all process
1774	!!
1775	!! \n
1776	!_ ==============================================================================================================================
1777	SUBROUTINE restput_p_nogrid_r_scal (fid,vname_q,itau,var)
1778	IMPLICIT NONE
1779	!-
1780	INTEGER :: fid
1781	CHARACTER(LEN=*) :: vname_q
1782	INTEGER :: itau
1783	REAL :: var
1784	!-----------------------------
1785	REAL :: xtmp(1)
1786
1787	IF (is_root_prc) THEN
1788	xtmp(1) = var
1789	CALL restput (fid, vname_q, 1, 1, 1, itau, xtmp)
1790	ENDIF
1791
1792	END SUBROUTINE restput_p_nogrid_r_scal
1793
1794	!! =============================================================================================================================
1795	!! SUBROUTINE: restput_p_nogrid_i_scal
1796	!!
1797	!>\BRIEF save integer scalar (non-grid) data into the restart file
1798	!!
1799	!! DESCRIPTION: Need to be call by all process
1800	!!
1801	!! \n
1802	!_ ==============================================================================================================================
1803	SUBROUTINE restput_p_nogrid_i_scal (fid,vname_q,itau,var)
1804	IMPLICIT NONE
1805	!-
1806	INTEGER :: fid
1807	CHARACTER(LEN=*) :: vname_q
1808	INTEGER :: itau
1809	INTEGER :: var
1810	!-----------------------------
1811	REAL :: xtmp(1)
1812	REAL :: realvar
1813
1814	IF (is_root_prc) THEN
1815	realvar = REAL(var,r_std)
1816	xtmp(1) = realvar
1817	CALL restput (fid, vname_q, 1, 1, 1, itau, xtmp)
1818	ENDIF
1819
1820	END SUBROUTINE restput_p_nogrid_i_scal
1821
1822	!! =============================================================================================================================
1823	!! SUBROUTINE: histwrite_r1d_p
1824	!!
1825	!>\BRIEF give the data (real 1D) to the IOIPSL system (if we don't use XIOS).
1826	!!
1827	!! DESCRIPTION: Need to be call by all process
1828	!!
1829	!! \n
1830	!_ ==============================================================================================================================
1831	SUBROUTINE histwrite_r1d_p(pfileid,pvarname,pitau,pdata,nbindex,nindex)
1832	IMPLICIT NONE
1833	!-
1834	INTEGER,INTENT(IN) :: pfileid, pitau, nbindex, nindex(nbindex)
1835	REAL,DIMENSION(:),INTENT(IN) :: pdata
1836	CHARACTER(LEN=*),INTENT(IN) :: pvarname
1837
1838	REAL,DIMENSION(nbp_mpi) :: pdata_mpi
1839
1840	IF (pfileid > 0) THEN
1841	! Continue only if the file is initilalized
1842	CALL gather_omp(pdata,pdata_mpi)
1843	IF (is_omp_root) THEN
1844	CALL histwrite(pfileid,pvarname,pitau,pdata_mpi,nbp_mpi,kindex_mpi)
1845	ENDIF
1846	END IF
1847
1848	END SUBROUTINE histwrite_r1d_p
1849
1850	!! =============================================================================================================================
1851	!! SUBROUTINE: histwrite_r2d_p
1852	!!
1853	!>\BRIEF give the data (real 2D) to the IOIPSL system (if we don't use XIOS).
1854	!!
1855	!! DESCRIPTION: Need to be call by all process
1856	!!
1857	!! \n
1858	!_ ==============================================================================================================================
1859	SUBROUTINE histwrite_r2d_p(pfileid,pvarname,pitau,pdata,nbindex,nindex)
1860	IMPLICIT NONE
1861	!-
1862	INTEGER,INTENT(IN) :: pfileid, pitau, nbindex, nindex(nbindex)
1863	REAL,DIMENSION(:,:),INTENT(IN) :: pdata
1864	CHARACTER(LEN=*),INTENT(IN) :: pvarname
1865
1866	IF (pfileid > 0) THEN
1867	! Continue only if the file is initilalized
1868	CALL body(size(pdata,2),nindex)
1869	END IF
1870
1871	CONTAINS
1872
1873	SUBROUTINE body(dim,nindex)
1874	INTEGER :: dim
1875	INTEGER :: nindex(nbp_omp,dim)
1876
1877	INTEGER :: nindex_mpi(nbp_mpi,dim)
1878	REAL :: pdata_mpi(nbp_mpi,dim)
1879	INTEGER :: flat_nindex_mpi(nbp_mpi * dim)
1880
1881	CALL gather_omp(pdata,pdata_mpi)
1882	CALL gather_omp(nindex,nindex_mpi)
1883
1884	IF (is_omp_root) THEN
1885	flat_nindex_mpi(:) = reshape(nindex_mpi,(/nbp_mpi*dim/))
1886	CALL histwrite(pfileid,pvarname,pitau,pdata_mpi,nbp_mpi*dim,flat_nindex_mpi)
1887	ENDIF
1888	END SUBROUTINE body
1889
1890	END SUBROUTINE histwrite_r2d_p
1891
1892	!! =============================================================================================================================
1893	!! SUBROUTINE: histwrite_r3d_p
1894	!!
1895	!>\BRIEF give the data (real 3D) to the IOIPSL system (if we don't use XIOS).
1896	!!
1897	!! DESCRIPTION: Need to be call by all process
1898	!!
1899	!! \n
1900	!_ ==============================================================================================================================
1901	SUBROUTINE histwrite_r3d_p(pfileid,pvarname,pitau,pdata,nbindex,nindex)
1902	IMPLICIT NONE
1903	!-
1904	INTEGER,INTENT(IN) :: pfileid, pitau, nbindex, nindex(nbindex)
1905	REAL,DIMENSION(:,:,:),INTENT(IN) :: pdata
1906	CHARACTER(LEN=*),INTENT(IN) :: pvarname
1907
1908	CHARACTER(LEN=10) :: part_str
1909	CHARACTER(LEN=LEN(part_str) + LEN(pvarname) + 1) :: var_name
1910	REAL,DIMENSION(SIZE(pdata, 1),SIZE(pdata, 2)) :: tmparr
1911	INTEGER :: jv
1912
1913	DO jv = 1, SIZE(pdata, 3)
1914	WRITE(part_str,'(I2)') jv
1915	IF (jv < 10) part_str(1:1) = '0'
1916	var_name = TRIM(pvarname)//'_'//part_str(1:LEN_TRIM(part_str))
1917	tmparr = pdata(:,:,jv)
1918	CALL histwrite_r2d_p(pfileid, var_name, pitau, tmparr, nbindex, nindex)
1919	ENDDO
1920
1921
1922	END SUBROUTINE histwrite_r3d_p
1923
1924	!! =============================================================================================================================
1925	!! SUBROUTINE: rest_o_nb_dims
1926	!!
1927	!>\BRIEF Get the number of Orchidee dimensions for a given variable name in the restart file
1928	!!
1929	!! DESCRIPTION: Get the number of Orchidee dimensions for a given variable name
1930	!! from the restart file.
1931	!! -
1932	!!
1933	!! \n
1934	!_ ==============================================================================================================================
1935	FUNCTION rest_o_nb_dims(rest_id, var_name) RESULT (nbdims)
1936
1937	INTEGER,INTENT(IN) :: rest_id
1938	CHARACTER(LEN=*),INTENT(IN) :: var_name
1939
1940	INTEGER :: nbdims ! Output
1941
1942	INTEGER(i_std),PARAMETER :: ovarnbdim_maxval=20 !! maximal # of dimensions assumed for any variable
1943	INTEGER,DIMENSION(ovarnbdim_maxval) :: vardims !! length of each dimension of a given variable
1944	INTEGER(i_std) :: varnbdim !! # of dimensions of a given variable
1945	!! of the stomate restart file
1946	LOGICAL :: is_scalar
1947
1948	CALL ioget_vdim (rest_id, var_name, ovarnbdim_maxval, varnbdim, vardims)
1949
1950	! is it scalar?
1951	is_scalar = ioget_var_is_scalar(vardims)
1952	! DEBUG line
1953	!WRITE(,) "rest_o_nb_dims:: ", TRIM(var_name),": ", varnbdim, "-", vardims(1:varnbdim)
1954
1955	IF (is_scalar) THEN
1956	nbdims = 1
1957	ELSE
1958	nbdims = varnbdim - 2 ! exclude time dimension introduced by IOIPSL
1959	! exclude merged x-y to nbp_glo
1960	ENDIF
1961
1962	END FUNCTION rest_o_nb_dims
1963
1964
1965	!! =============================================================================================================================
1966	!! SUBROUTINE:
1967	!!
1968	!>\BRIEF Get the number of Orchidee dimensions for a given variable name in the restart file
1969	!!
1970	!! DESCRIPTION: Get the number of Orchidee dimensions for a given variable name
1971	!from the input restart file
1972	!! -
1973	!!
1974	!! \n
1975	!_ ==============================================================================================================================
1976	FUNCTION ioget_var_is_scalar(vardims) RESULT (is_scalar)
1977
1978	INTEGER,INTENT(IN) :: vardims(:) !! length of each dimension of a given variable
1979
1980	LOGICAL :: is_scalar ! Output
1981
1982	! is it scalar?
1983	is_scalar = ALL(vardims == 1)
1984
1985	END FUNCTION ioget_var_is_scalar
1986
1987
1988	!! =============================================================================================================================
1989	!! SUBROUTINE: restransfer_scal
1990	!!
1991	!>\BRIEF Move variable data from the input restart file to the output
1992	!!
1993	!! DESCRIPTION: It applies to Real scalar values
1994	!!
1995	!! \n
1996	!_ ==============================================================================================================================
1997	SUBROUTINE restransfer_scal(rest_id, var_name, itau)
1998	INTEGER,INTENT(IN) :: rest_id, itau
1999	CHARACTER(LEN=*),INTENT(IN) :: var_name
2000
2001	REAL(r_std),DIMENSION(1) :: xtmp !! scalar read/written in restget/restput routines (unitless)
2002
2003	CALL restget (rest_id, var_name, 1, 1, 1, itau, .TRUE., xtmp)
2004	CALL restput (rest_id, var_name, 1, 1, 1, itau, xtmp)
2005
2006	END SUBROUTINE restransfer_scal
2007
2008	!! =============================================================================================================================
2009	!! SUBROUTINE: restransfer_opp_rXd
2010	!!
2011	!>\BRIEF Transfer a variable from the input to the output restart file
2012	!!
2013	!! DESCRIPTION: Transfer a variable from the input to the output restart file
2014	!! rest_id defines the output restart forcing id
2015	!! Only for single processor, make sure it is wrapped in is_root_proc
2016	!! \n
2017	!_ ==============================================================================================================================
2018	SUBROUTINE restransfer_opp_r1d &
2019	(rest_id, vname_q, vardims, itau, nbindex, ijndex)
2020	IMPLICIT NONE
2021	!-
2022	INTEGER, INTENT(in) :: rest_id ! output restart forcing id
2023	CHARACTER(LEN=*), INTENT(in) :: vname_q ! Variable name to transfer
2024	INTEGER, INTENT(in) :: vardims(1) ! Variable dimensions
2025	INTEGER, INTENT(in) :: itau ! timestep
2026	INTEGER, INTENT(in) :: nbindex, ijndex(nbindex) ! data info from continental gridcells to 2D
2027	!-----------------------------
2028	REAL, ALLOCATABLE, DIMENSION(:) :: var
2029	INTEGER :: ier
2030
2031	! vardims X(1), Y(2), remaining variables, time(last position)
2032	ALLOCATE( var(vardims(1)), stat=ier)
2033	IF (ier /= 0) CALL ipslerr(3, 'restransfer_r1d', 'var : error in memory allocation', '', '')
2034	!----
2035	CALL restget &
2036	& (rest_id, vname_q, vardims(1), 1, &
2037	& 1, itau, .TRUE., var, "gather", nbindex, ijndex)
2038	CALL restput &
2039	& (rest_id, vname_q, vardims(1), 1, &
2040	& 1, itau, var, 'scatter', nbindex, ijndex)
2041	!----
2042	DEALLOCATE(var)
2043
2044	END SUBROUTINE restransfer_opp_r1d
2045
2046
2047	SUBROUTINE restransfer_opp_r2d &
2048	(rest_id, vname_q, vardims, itau, nbindex, ijndex)
2049	IMPLICIT NONE
2050	!-
2051	INTEGER, INTENT(in) :: rest_id
2052	CHARACTER(LEN=*), INTENT(in) :: vname_q
2053	INTEGER, INTENT(in) :: vardims(2)
2054	INTEGER :: itau
2055	INTEGER :: nbindex, ijndex(nbindex)
2056	!-----------------------------
2057	INTEGER :: ier
2058	REAL, ALLOCATABLE, DIMENSION(:,:) :: var
2059	! vardims X(1), Y(2), remaining variables, time(last position)
2060	ALLOCATE( var(vardims(1), vardims(2)), stat=ier)
2061	IF (ier /= 0) CALL ipslerr(3, 'restransfer_r2d', 'var : error in memory allocation', '', '')
2062	!----
2063	CALL restget &
2064	& (rest_id, vname_q, vardims(1), vardims(2), &
2065	& 1, itau, .TRUE., var, "gather", nbindex, ijndex)
2066	CALL restput &
2067	& (rest_id, vname_q, vardims(1), vardims(2), &
2068	& 1, itau, var, 'scatter', nbindex, ijndex)
2069	!----
2070	DEALLOCATE(var)
2071
2072	END SUBROUTINE restransfer_opp_r2d
2073
2074
2075	SUBROUTINE restransfer_opp_r3d &
2076	(rest_id, vname_q, vardims, itau, nbindex, ijndex)
2077	IMPLICIT NONE
2078	!-
2079	INTEGER, INTENT(in) :: rest_id
2080	CHARACTER(LEN=*), INTENT(in) :: vname_q
2081	INTEGER, INTENT(in) :: vardims(3)
2082	INTEGER :: itau, ier
2083	INTEGER :: nbindex, ijndex(nbindex)
2084	!-----------------------------
2085	REAL, ALLOCATABLE, DIMENSION(:,:,:) :: var
2086	! vardims X(1), Y(2), remaining variables, time(last position)
2087	ALLOCATE( var(vardims(1), vardims(2), vardims(3)), stat=ier)
2088	IF (ier /= 0) CALL ipslerr(3, 'restransfer_r3d', 'var : error in memory allocation', '', '')
2089	!----
2090	CALL restget &
2091	& (rest_id, vname_q, vardims(1), vardims(2), &
2092	& vardims(3), itau, .TRUE., var, "gather", nbindex, ijndex)
2093	CALL restput &
2094	& (rest_id, vname_q, vardims(1), vardims(2), &
2095	& vardims(3), itau, var, 'scatter', nbindex, ijndex)
2096	!----
2097	DEALLOCATE(var)
2098
2099	END SUBROUTINE restransfer_opp_r3d
2100
2101
2102	SUBROUTINE restransfer_opp_r4d &
2103	(rest_id, vname_q, vardims, itau, nbindex, ijndex)
2104	IMPLICIT NONE
2105	!-
2106	INTEGER, INTENT(in) :: rest_id
2107	CHARACTER(LEN=*), INTENT(in) :: vname_q
2108	INTEGER, INTENT(in) :: vardims(4)
2109	INTEGER :: itau, ier
2110	INTEGER :: nbindex, ijndex(nbindex)
2111	!-----------------------------
2112	REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: var
2113	! vardims X(1), Y(2), remaining variables, time(last position)
2114	ALLOCATE( var(vardims(1), vardims(2), vardims(3), vardims(4)), stat=ier)
2115	IF (ier /= 0) CALL ipslerr(3, 'restransfer_r4d', 'var : error in memory allocation', '', '')
2116	!----
2117	CALL restget &
2118	& (rest_id, vname_q, vardims(1), vardims(2), &
2119	& vardims(3), vardims(4), itau, .TRUE., var, "gather", nbindex, ijndex)
2120	CALL restput &
2121	& (rest_id, vname_q, vardims(1), vardims(2), &
2122	& vardims(3), vardims(4), itau, var, 'scatter', nbindex, ijndex)
2123	!----
2124	DEALLOCATE(var)
2125
2126	END SUBROUTINE restransfer_opp_r4d
2127
2128
2129	SUBROUTINE restransfer_opp_r5d &
2130	(rest_id, vname_q, vardims, itau, nbindex, ijndex)
2131	IMPLICIT NONE
2132	!-
2133	INTEGER, INTENT(in) :: rest_id
2134	CHARACTER(LEN=*), INTENT(in) :: vname_q
2135	INTEGER, INTENT(in) :: vardims(5)
2136	INTEGER :: itau, ier
2137	INTEGER :: nbindex, ijndex(nbindex)
2138	!-----------------------------
2139	REAL, ALLOCATABLE, DIMENSION(:,:,:,:,:) :: var
2140	! vardims X(1), Y(2), remaining variables, time(last position)
2141	ALLOCATE( var(vardims(1), vardims(2), vardims(3), vardims(4), vardims(5)), stat=ier)
2142	IF (ier /= 0) CALL ipslerr(3, 'restransfer_r5d', 'var : error in memory allocation', '', '')
2143	!----
2144	CALL restget &
2145	& (rest_id, vname_q, vardims(1), vardims(2), &
2146	& vardims(3), vardims(4), vardims(5), itau, .TRUE., var, "gather", nbindex, ijndex)
2147	CALL restput &
2148	& (rest_id, vname_q, vardims(1), vardims(2), &
2149	& vardims(3), vardims(4), vardims(5), itau, var, 'scatter', nbindex, ijndex)
2150	!----
2151	DEALLOCATE(var)
2152
2153	END SUBROUTINE restransfer_opp_r5d
2154
2155
2156	!! =============================================================================================================================
2157	!! SUBROUTINE: restransfer_var
2158	!!
2159	!>\BRIEF Transfer a variable from the input to the output restart file
2160	!!
2161	!! DESCRIPTION: Available for scalar and restXXX_opp_rXd variable types
2162	!! \n
2163	!_ ==============================================================================================================================
2164	SUBROUTINE restransfer_var (rest_id, vname_q, itau, nbindex, ijndex)
2165	IMPLICIT NONE
2166	!-
2167	INTEGER, INTENT(in) :: rest_id ! output restart file id
2168	CHARACTER(LEN=*), INTENT(in) :: vname_q ! variable name
2169	INTEGER :: itau, ier ! restart time step
2170	INTEGER :: nbindex, ijndex(nbindex) ! continental landpoints to 2D world gridpoints
2171	!-----------------------------
2172	INTEGER(i_std) :: varnbdim !! # of dimensions of a given variable
2173	!! of the stomate restart file
2174	INTEGER(i_std),PARAMETER :: varnbdim_max=20 !! maximal # of dimensions assumed for any variable
2175	!! of the stomate restart file
2176	INTEGER,DIMENSION(varnbdim_max) :: vardims !! length of each dimension of a given variable
2177	!! of the stomate restart file
2178
2179	LOGICAL :: is_var_scalar
2180	INTEGER(i_std) :: orch_vardims ! orchidee variables
2181	CHARACTER(LEN=:), ALLOCATABLE :: msg3
2182	!-----------------------------
2183
2184	CALL ioget_vdim (rest_id, vname_q, varnbdim_max, varnbdim, vardims)
2185
2186	is_var_scalar = ioget_var_is_scalar(vardims(1:varnbdim))
2187
2188	IF (is_var_scalar) THEN
2189	CALL restransfer_scal (rest_id, vname_q, itau)
2190	ELSE
2191	! From restart to orchidee number of dimensions
2192	orch_vardims = rest_o_nb_dims(rest_id, vname_q)
2193
2194	IF (orch_vardims == 1) THEN
2195	!----
2196	CALL restransfer_opp_r1d(rest_id, vname_q, (/ nbindex /), &
2197	itau, nbindex, ijndex)
2198	!----
2199	ELSE IF (orch_vardims == 2) THEN
2200	!----
2201	CALL restransfer_opp_r2d(rest_id, vname_q, (/ nbindex, vardims(3) /), &
2202	itau, nbindex, ijndex)
2203	ELSE IF (orch_vardims == 3) THEN
2204	!----
2205	CALL restransfer_opp_r3d(rest_id, vname_q, (/ nbindex, vardims(3), vardims(4) /), &
2206	itau, nbindex, ijndex)
2207	ELSE IF (orch_vardims == 4) THEN
2208	!----
2209	CALL restransfer_opp_r4d(rest_id, vname_q, (/ nbindex, vardims(3), vardims(4), vardims(5) /), &
2210	itau, nbindex, ijndex)
2211	ELSE IF (orch_vardims == 5) THEN
2212	!----
2213	CALL restransfer_opp_r5d(rest_id, vname_q, (/ nbindex, vardims(3), vardims(4), vardims(5), vardims(6) /), &
2214	itau, nbindex, ijndex)
2215	ELSE
2216	WRITE( msg3, '(i5)' ) orch_vardims
2217	CALL ipslerr(3, 'restransfer', 'Restart variable not implemented for N dimensions', &
2218	& vname_q, TRIM(msg3))
2219	ENDIF ! orch_vardims == int(X)
2220	ENDIF ! is_var_scalar
2221
2222
2223	END SUBROUTINE restransfer_var
2224
2225	END MODULE ioipsl_para

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

Download in other formats: