Home

Context Navigation

Back to doc/tec/developerrules

developerrules: template_newmodule_mod_v2.f90

File template_newmodule_mod_v2.f90, 24.7 KB (added by maronga, 8 years ago)
Module Template

Line
1	!!!
2	!!! Problems to be solved:
3	!!! a) The error message mimic "PAXXXX" is problematic as developers need to
4	!!! browse through PALM every time they insert a new number. I would suggest
5	!!! to change the mimic as follows:
6	!!! "PALMXXXX" - PALM core error message
7	!!! "USERXXXX" - User interface error messages
8	!!! "NCDFXXXX" - NetCDF error messages
9	!!! "LSM_XXXX" - Land surface model error messages
10	!!! etc.
11	!!! b) The numbering of output profiles violates the modular concept. The number of
12	!!! profiles should be dynamic, depending on the modules used for the specific
13	!!! run. This could be solved by having a profile counter which stores the
14	!!! current number of profiles. Each module can then increase this counter and
15	!!! define profiles. This basically needs rather big changes in flow_statistics.
16	!!! Who can do that (I gave it up due to lack of time)?
17	!!! c) The calls from data_output_2d etc. to most modules are done via the
18	!!! CASE DEFAULT branch like it is done for the user interface (e.g. LSM).
19	!!! However, the urban canopy module deviates from this mimic. We need to talk
20	!!! about a consistent way of doing this.
21	!!! d) Some routines need renaming (user_* or lsm_* etc.):
22	!!! - user_last_actions should be user_write_restart_data or user_write_3d_binary.
23	!!! It is also strange that write_3d_binary is called from PALM, but read_3d_binary
24	!!! is not (from init_3d_model). I think we need a clean concept here.
25	!!! - user_read_restart_data is called from read_3d_binary. It could thus be named
26	!!! user_read_3d_binary?
27	!!!
28
29
30
31	!> @file newmodule_mod.f90
32	!--------------------------------------------------------------------------------!
33	! This file is part of PALM-4U.
34	!
35	! PALM-4U is free software: you can redistribute it and/or modify it under the
36	! terms of the GNU General Public License as published by the Free Software
37	! Foundation, either version 3 of the License, or (at your option) any later
38	! version.
39	!
40	! PALM-4U is distributed in the hope that it will be useful, but WITHOUT ANY
41	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
42	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
43	!
44	! You should have received a copy of the GNU General Public License along with
45	! PALM. If not, see <http://www.gnu.org/licenses/>.
46	!
47	! Copyright 2016 Leibniz Universitaet Hannover, <your institution>
48	!--------------------------------------------------------------------------------!
49	!
50	! Current revisions:
51	! -----------------
52	! Initial revision
53	!
54	! Former revisions:
55	! -----------------
56	! $Id$
57	!
58	! Authors:
59	! --------
60	! @author <List of authors that contributed to this module>
61	!
62	!
63	! Description:
64	! ------------
65	!> <Description of the new module>
66	!>
67	!>
68	!> @todo <Enter things that remain to be done>
69	!> @note <Enter notes on the module>
70	!> @bug <Enter known bugs here>
71	!------------------------------------------------------------------------------!
72	MODULE newmodule_mod
73
74
75	USE control_parameters, &
76	ONLY: initializing_actions
77
78	!
79	!-- Load required variables from existing modules
80	!-- USE modulename, &
81	!-- ONLY: ...
82
83
84	IMPLICIT NONE
85
86	!
87	!-- Declare all global variables within the module (alphabetical order)
88	!-- CHARACTER :: global_string_a !<
89	!-- CHARACTER :: global_string_b !<
90	!--
91	!-- INTEGER(iwp) :: global_int_var_a !<
92	!-- INTEGER(iwp) :: global_int_var_b !<
93	!--
94	!-- LOGICAL :: global_flag_a !<
95	!-- LOGICAL :: global_flag_b !<
96	!--
97	!-- REAL(wp) :: global_real_var_a !<
98	!-- REAL(wp) :: global_real_var_b !<
99	!-- ...
100
101	SAVE
102
103
104	PRIVATE
105
106
107	!
108	!-- Add INTERFACES that must be available to other modules (alphabetical order)
109	!-- PUBLIC ...
110
111	!
112	!-- Add VARIABLES that must be available to other modules (alphabetical order)
113	!-- PUBLIC ...
114
115	!
116	!-- Add PROGNOSTIC QUANTITIES that must be available to other modules (alphabetical order)
117	!-- PUBLIC ...
118
119
120	!
121	!-- Default procedures for all new modules (not all are necessarily required,
122	!-- alphabetical order is not essential)
123
124	!
125	!-- PALM interfaces:
126	!-- Data output checks for 2D/3D data to be done in check_parameters
127	INTERFACE newmodule_check_data_output
128	MODULE PROCEDURE newmodule_check_data_output
129	END INTERFACE newmodule_check_data_output
130
131	!
132	!-- Data output checks for profile data to be done in check_parameters
133	INTERFACE newmodule_check_data_output_pr
134	MODULE PROCEDURE newmodule_check_data_output_pr
135	END INTERFACE newmodule_check_data_output_pr
136
137	!
138	!-- Input parameter checks to be done in check_parameters
139	INTERFACE newmodule_check_parameters
140	MODULE PROCEDURE newmodule_check_parameters
141	END INTERFACE newmodule_check_parameters
142
143	!
144	!-- Averaging of 3D data for output
145	INTERFACE newmodule_3d_data_averaging
146	MODULE PROCEDURE newmodule_3d_data_averaging
147	END INTERFACE newmodule_3d_data_averaging
148
149	!
150	!-- Data output of 2D quantities
151	INTERFACE newmodule_data_output_2d
152	MODULE PROCEDURE newmodule_data_output_2d
153	END INTERFACE newmodule_data_output_2d
154
155	!
156	!-- Data output of 3D data
157	INTERFACE newmodule_data_output_3d
158	MODULE PROCEDURE newmodule_data_output_3d
159	END INTERFACE newmodule_data_output_3d
160
161	!
162	!-- Definition of data output quantities
163	INTERFACE newmodule_define_netcdf_grid
164	MODULE PROCEDURE newmodule_define_netcdf_grid
165	END INTERFACE newmodule_define_netcdf_grid
166
167	!
168	!-- Output of information to the header file
169	INTERFACE newmodule_header
170	MODULE PROCEDURE newmodule_header
171	END INTERFACE newmodule_header
172
173	!
174	!-- Initialization actions
175	INTERFACE newmodule_init
176	MODULE PROCEDURE newmodule_init
177	END INTERFACE newmodule_init
178
179	!
180	!-- Initialization of arrays
181	INTERFACE newmodule_init_arrays
182	MODULE PROCEDURE newmodule_init_arrays
183	END INTERFACE newmodule_init_arrays
184
185	!
186	!-- Writing of binary output for restart runs !!! renaming?!
187	INTERFACE newmodule_last_actions
188	MODULE PROCEDURE newmodule_last_actions
189	END INTERFACE newmodule_last_actions
190
191	!
192	!-- Reading of NAMELIST parameters
193	INTERFACE newmodule_parin
194	MODULE PROCEDURE newmodule_parin
195	END INTERFACE newmodule_parin
196
197	!
198	!-- Reading of parameters for restart runs
199	INTERFACE newmodule_read_restart_data
200	MODULE PROCEDURE newmodule_read_restart_data
201	END INTERFACE newmodule_read_restart_data
202
203	!
204	!-- Writing of parameters for restart runs !!! renaming?!
205	INTERFACE newmodule_skip_var_list
206	MODULE PROCEDURE newmodule_skip_var_list
207	END INTERFACE newmodule_skip_var_list
208
209	!
210	!-- Swapping of time levels (required for prognostic variables)
211	INTERFACE newmodule_swap_timelevel
212	MODULE PROCEDURE newmodule_swap_timelevel
213	END INTERFACE newmodule_swap_timelevel
214
215
216
217	!
218	!-- New module-specific procedure(s) (alphabetical order):
219	INTERFACE newmodule_newprocedure
220	MODULE PROCEDURE newmodule_newprocedure
221	END INTERFACE newmodule_newprocedure
222
223	CONTAINS
224
225	!------------------------------------------------------------------------------!
226	! Description:
227	! ------------
228	!> Check data output for new module.
229	!------------------------------------------------------------------------------!
230	SUBROUTINE newmodule_check_data_output( var, unit, i, ilen, k )
231
232	USE control_parameters, &
233	ONLY: data_output, message_string
234
235	IMPLICIT NONE
236
237	CHARACTER (LEN=*) :: unit !<
238	CHARACTER (LEN=*) :: var !<
239
240	INTEGER(iwp) :: i !<
241	INTEGER(iwp) :: ilen !<
242	INTEGER(iwp) :: k !<
243
244	SELECT CASE ( TRIM( var ) )
245
246	!
247	!-- e.g. output of "output_var" requires new_module = .TRUE.. In that case
248	!-- the unit of the output variable is set. Make sure that PAXXXX is replaced
249	!-- by a number according to PALMs internal counter (e.g. PA0412)
250	! CASE ( 'output_var' )
251	! IF ( .NOT. new_module ) THEN
252	! message_string = 'output of "' // TRIM( var ) // '" requi' // &
253	! 'res new_module = .TRUE.'
254	! CALL message( 'check_parameters', 'PAXXXX', 1, 2, 0, 6, 0 )
255	! ENDIF
256	! unit = 'm/m3'
257
258	CASE DEFAULT
259	unit = 'illegal'
260
261	END SELECT
262
263	END SUBROUTINE newmodule_check_data_output
264
265
266	!------------------------------------------------------------------------------!
267	! Description:
268	! ------------
269	!> Check data output of profiles for new module.
270	!------------------------------------------------------------------------------!
271	SUBROUTINE newmodule_check_data_output_pr( variable, var_count, unit, dopr_unit )
272
273	USE control_parameters, &
274	ONLY: data_output_pr, message_string
275
276	USE indices
277
278	USE profil_parameter
279
280	USE statistics
281
282	IMPLICIT NONE
283
284	CHARACTER (LEN=*) :: dopr_unit !< local value of dopr_unit
285	CHARACTER (LEN=*) :: unit !<
286	CHARACTER (LEN=*) :: variable !<
287
288	INTEGER(iwp) :: user_pr_index !<
289	INTEGER(iwp) :: var_count !<
290
291	SELECT CASE ( TRIM( variable ) )
292
293	!
294	!-- e.g. output of "output_var". #output_var can be assigned when the initial
295	!-- profile at time = 0 can be output. Output is only allowed if
296	!-- new_module = .TRUE.. Then, the number of profiles in PALM needs to be
297	!-- increased and the unit is set. The numbers below must be adjusted and
298	!-- must match the specification on flow_statistics. Make sure that PAXXXX is
299	!-- replaced by a number according to PALMs internal counter (e.g. PA0412).
300	!-- This numbering violates the modular concept - we need a new solution here!
301	! CASE ( 'output_var', '#output_var' )
302	! IF ( .NOT. land_surface ) THEN
303	! message_string = 'data_output_pr = ' // &
304	! TRIM( data_output_pr(var_count) ) // ' is' // &
305	! 'not implemented for new_module = .FALSE.'
306	! CALL message( 'check_parameters', 'PAXXXX', 1, 2, 0, 6, 0 )
307	! ELSE
308	! dopr_index(var_count) = 89
309	! dopr_unit = 'K'
310	! hom(0:nzs-1,2,89,:) = SPREAD( - zs, 2, statistic_regions+1 )
311	! IF ( data_output_pr(var_count)(1:1) == '#' ) THEN
312	! dopr_initial_index(var_count) = 90
313	! hom(0:nzs-1,2,90,:) = SPREAD( zu, 2, statistic_regions+1 )
314	! data_output_pr(var_count) = data_output_pr(var_count)(2:)
315	! ENDIF
316	! unit = dopr_unit
317	! ENDIF
318
319	CASE DEFAULT
320	unit = 'illegal'
321
322	END SELECT
323
324	END SUBROUTINE newmodule_check_data_output_pr
325
326
327	!------------------------------------------------------------------------------!
328	! Description:
329	! ------------
330	!> Check parameters routine for new module
331	!------------------------------------------------------------------------------!
332	SUBROUTINE newmodule_check_parameters
333
334	USE control_parameters, &
335	ONLY: message_string
336
337
338	IMPLICIT NONE
339
340	!
341	!-- Checks go here (cf. check_parameters.f90).
342
343	END SUBROUTINE newmodule_check_parameters
344
345	!------------------------------------------------------------------------------!
346	!
347	! Description:
348	! ------------
349	!> Subroutine for averaging 3D data
350	!------------------------------------------------------------------------------!
351	SUBROUTINE newmodule_3d_data_averaging( mode, variable )
352
353
354	USE control_parameters
355
356	USE indices
357
358	USE kinds
359
360	IMPLICIT NONE
361
362	CHARACTER (LEN=*) :: mode !<
363	CHARACTER (LEN=*) :: variable !<
364
365	INTEGER(iwp) :: i !<
366	INTEGER(iwp) :: j !<
367	INTEGER(iwp) :: k !<
368
369	IF ( mode == 'allocate' ) THEN
370
371	SELECT CASE ( TRIM( variable ) )
372
373	! CASE ( 'output_var_twod' )
374	! IF ( .NOT. ALLOCATED( output_var_twod_av ) ) THEN
375	! ALLOCATE( output_var_twod_av(nysg:nyng,nxlg:nxrg) )
376	! ENDIF
377	! output_var_twod_av = 0.0_wp
378	!
379	! CASE ( 'output_var_threed' )
380	! IF ( .NOT. ALLOCATED( output_var_threed_av ) ) THEN
381	! ALLOCATE( output_var_threed_av(nzb:nzt,nysg:nyng,nxlg:nxrg) )
382	! ENDIF
383	! output_var_threed_av = 0.0_wp
384
385	CASE DEFAULT
386	CONTINUE
387
388	END SELECT
389
390	ELSEIF ( mode == 'sum' ) THEN
391
392	SELECT CASE ( TRIM( variable ) )
393
394	! CASE ( 'output_var_twod' )
395	! DO i = nxlg, nxrg
396	! DO j = nysg, nyng
397	! c_liq_av(j,i) = c_liq_av(j,i) + c_liq(j,i)
398	! ENDDO
399	! ENDDO
400	!
401	! CASE ( 'output_var_threed' )
402	! DO i = nxlg, nxrg
403	! DO j = nysg, nyng
404	! DO k = nzb, nzt
405	! output_var_threed_av(k,j,i) = output_var_threed_av(k,j,i)&
406	! + output_var_threed(k,j,i)
407	! ENDDO
408	! ENDDO
409	! ENDDO
410
411	CASE DEFAULT
412	CONTINUE
413
414	END SELECT
415
416	ELSEIF ( mode == 'average' ) THEN
417
418	SELECT CASE ( TRIM( variable ) )
419
420	! CASE ( 'output_var_twod' )
421	! DO i = nxlg, nxrg
422	! DO j = nysg, nyng
423	! c_liq_av(j,i) = c_liq_av(j,i) / REAL( average_count_3d, &
424	! KIND=wp )
425	! ENDDO
426	! ENDDO
427	!
428	! CASE ( 'output_var_threed' )
429	! DO i = nxlg, nxrg
430	! DO j = nysg, nyng
431	! DO k = nzb, nzt+1
432	! output_var_threed_av(k,j,i) = output_var_threed_av(k,j,i)&
433	! / REAL( average_count_3d, KIND=wp )
434	! ENDDO
435	! ENDDO
436	! ENDDO
437
438	END SELECT
439
440	ENDIF
441
442	END SUBROUTINE newmodule_3d_data_averaging
443
444
445	!------------------------------------------------------------------------------!
446	!
447	! Description:
448	! ------------
449	!> Subroutine defining 3D output variables
450	!------------------------------------------------------------------------------!
451	SUBROUTINE newmodule_data_output_2d( av, variable, found, grid, mode, &
452	local_pf, two_d, nzb_do, nzt_do )
453
454	USE indices
455
456	USE kinds
457
458
459	IMPLICIT NONE
460
461	CHARACTER (LEN=*) :: grid !<
462	CHARACTER (LEN=*) :: mode !<
463	CHARACTER (LEN=*) :: variable !<
464
465	INTEGER(iwp) :: av !<
466	INTEGER(iwp) :: i !<
467	INTEGER(iwp) :: j !<
468	INTEGER(iwp) :: k !<
469	INTEGER(iwp) :: nzb_do !<
470	INTEGER(iwp) :: nzt_do !<
471
472	LOGICAL :: found !<
473	LOGICAL :: two_d !< flag parameter that indicates 2D variables (horizontal cross sections)
474
475	REAL(wp), DIMENSION(nxlg:nxrg,nysg:nyng,nzb:nzt+1) :: local_pf !< local (das hier ist ein Beispiel fÃŒr doxygen Zeilenumbruch)
476	!< array to which output data is resorted to
477
478	found = .TRUE.
479
480	SELECT CASE ( TRIM( variable ) )
481
482
483	! CASE ( 'output_var_twod_xy' ) ! 2d-array
484	! IF ( av == 0 ) THEN
485	! DO i = nxlg, nxrg
486	! DO j = nysg, nyng
487	! local_pf(i,j,nzb+1) = output_var_twod(j,i)
488	! ENDDO
489	! ENDDO
490	! ELSE
491	! DO i = nxlg, nxrg
492	! DO j = nysg, nyng
493	! local_pf(i,j,nzb+1) = output_var_twod_av(j,i)
494	! ENDDO
495	! ENDDO
496	! ENDIF
497	!
498	! two_d = .TRUE.
499	! grid = 'zu1'
500	!
501	! CASE ( 'output_var_threed_xy', 'output_var_threed_xz', &
502	! 'output_var_threed_yz' )
503	! IF ( av == 0 ) THEN
504	! DO i = nxlg, nxrg
505	! DO j = nysg, nyng
506	! DO k = nzb_do, nzt_do
507	! local_pf(i,j,k) = output_var_threed(k,j,i)
508	! ENDDO
509	! ENDDO
510	! ENDDO
511	! ELSE
512	! DO i = nxlg, nxrg
513	! DO j = nysg, nyng
514	! DO k = nzb_do, nzt_do
515	! local_pf(i,j,k) = output_var_threed_av(k,j,i)
516	! ENDDO
517	! ENDDO
518	! ENDDO
519	! ENDIF
520	!
521	! IF ( mode == 'xy' ) grid = 'zu'
522	!
523	CASE DEFAULT
524	found = .FALSE.
525	grid = 'none'
526
527	END SELECT
528
529	END SUBROUTINE newmodule_data_output_2d
530
531
532	!------------------------------------------------------------------------------!
533	!
534	! Description:
535	! ------------
536	!> Subroutine defining 3D output variables
537	!------------------------------------------------------------------------------!
538	SUBROUTINE newmodule_data_output_3d( av, variable, found, local_pf )
539
540
541	USE indices
542
543	USE kinds
544
545
546	IMPLICIT NONE
547
548	CHARACTER (LEN=*) :: variable !<
549
550	INTEGER(iwp) :: av !<
551	INTEGER(iwp) :: i !<
552	INTEGER(iwp) :: j !<
553	INTEGER(iwp) :: k !<
554
555	LOGICAL :: found !<
556
557	REAL(sp), DIMENSION(nxlg:nxrg,nysg:nyng,nzb:nzt+1) :: local_pf !< local
558	!< array to which output data is resorted to
559
560
561	found = .TRUE.
562
563
564	SELECT CASE ( TRIM( variable ) )
565
566
567	! CASE ( 'output_var_threed' )
568	!
569	! IF ( av == 0 ) THEN
570	! DO i = nxlg, nxrg
571	! DO j = nysg, nyng
572	! DO k = nzb, nzt+1
573	! local_pf(i,j,k) = output_var_threed(k,j,i)
574	! ENDDO
575	! ENDDO
576	! ENDDO
577	! ELSE
578	! DO i = nxlg, nxrg
579	! DO j = nysg, nyng
580	! DO k = nzb, nzt+1
581	! local_pf(i,j,k) = output_var_threed_av(k,j,i)
582	! ENDDO
583	! ENDDO
584	! ENDDO
585	! ENDIF
586
587	CASE DEFAULT
588	found = .FALSE.
589
590	END SELECT
591
592	END SUBROUTINE newmodule_data_output_3d
593
594
595	!------------------------------------------------------------------------------!
596	!
597	! Description:
598	! ------------
599	!> Subroutine defining appropriate grid for netcdf variables.
600	!> It is called out from subroutine netcdf.
601	!------------------------------------------------------------------------------!
602	SUBROUTINE newmodule_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
603
604	IMPLICIT NONE
605
606	CHARACTER (LEN=*), INTENT(OUT) :: grid_x !<
607	CHARACTER (LEN=*), INTENT(OUT) :: grid_y !<
608	CHARACTER (LEN=*), INTENT(OUT) :: grid_z !<
609	CHARACTER (LEN=*), INTENT(IN) :: var !<
610
611	LOGICAL, INTENT(OUT) :: found !<
612
613	found = .TRUE.
614
615	!
616	!-- Check for the grid
617	SELECT CASE ( TRIM( var ) )
618
619	CASE ( 'output_var_threed', 'output_var_threed_xy', &
620	'output_var_threed_xz', 'output_var_threed_yz' )
621	grid_x = 'x'
622	grid_y = 'y'
623	grid_z = 'zu'
624
625	CASE DEFAULT
626	found = .FALSE.
627	grid_x = 'none'
628	grid_y = 'none'
629	grid_z = 'none'
630	END SELECT
631
632	END SUBROUTINE newmodule_define_netcdf_grid
633
634
635	!------------------------------------------------------------------------------!
636	! Description:
637	! ------------
638	!> Header output for new module
639	!------------------------------------------------------------------------------!
640	SUBROUTINE newmodule_header ( io )
641
642
643	IMPLICIT NONE
644
645
646	INTEGER(iwp), INTENT(IN) :: io !< Unit of the output file
647
648	!
649	!-- Header output goes here
650	!-- ...
651
652	END SUBROUTINE newmodule_header
653
654
655	!------------------------------------------------------------------------------!
656	! Description:
657	! ------------
658	!> Initialization of the new module
659	!------------------------------------------------------------------------------!
660	SUBROUTINE newmodule_init
661
662	IMPLICIT NONE
663
664	!
665	!-- Actions for initial runs
666	IF ( TRIM( initializing_actions ) /= 'read_restart_data' ) THEN
667	!-- ...
668
669	!
670	!-- Actions for restart runs
671	ELSE
672	!-- ...
673
674	ENDIF
675
676	END SUBROUTINE newmodule_init
677
678
679	!------------------------------------------------------------------------------!
680	! Description:
681	! ------------
682	!> Allocate new module arrays and define pointers if required
683	!------------------------------------------------------------------------------!
684	SUBROUTINE newmodule_init_arrays
685
686
687	IMPLICIT NONE
688
689	!
690	!-- Allocate prognostic variables (see newmodule_swap_timelevel)
691	#if defined( __nopointer )
692	! ALLOCATE ( prog_var(nysg:nyng,nxlg:nxrg) )
693	! ALLOCATE ( prog_var_p(nysg:nyng,nxlg:nxrg) )
694
695	#else
696	! ALLOCATE ( prog_var_1(nysg:nyng,nxlg:nxrg) )
697	! ALLOCATE ( prog_var_2(nysg:nyng,nxlg:nxrg) )
698	#endif
699
700	!
701	!-- Allocate intermediate timestep arrays
702	! ALLOCATE ( tprog_var_m(nysg:nyng,nxlg:nxrg) )
703
704	!
705	!-- Allocate other arrays
706	! ALLOCATE ( some_array(nysg:nyng,nxlg:nxrg) )
707
708
709	#if ! defined( __nopointer )
710	!
711	!-- Initial assignment of the pointers
712	! prog_var => prog_var_1; prog_var_p => prog_var_2
713	#endif
714
715	END SUBROUTINE newmodule_init_arrays
716
717
718	!------------------------------------------------------------------------------!
719	! Description:
720	! ------------
721	!> Parin for &newmodule_par for new modules
722	!------------------------------------------------------------------------------!
723	SUBROUTINE newmodule_parin
724
725	IMPLICIT NONE
726
727	CHARACTER (LEN=80) :: line !< dummy string that contains the current line of the parameter file
728
729	!
730	!-- Add all variables that should be read via the NAMELIST environment. No
731	!-- further modifications should be necessary in this subroutine
732	! NAMELIST /newmodule_par/ parameter_a, parameter_b
733
734	line = ' '
735
736	!
737	!-- Try to find newmodule package
738	REWIND ( 11 )
739	line = ' '
740	DO WHILE ( INDEX( line, '&newmodule_par' ) == 0 )
741	READ ( 11, '(A)', END=10 ) line
742	ENDDO
743	BACKSPACE ( 11 )
744
745	!
746	!-- Read user-defined namelist
747	READ ( 11, newmodule_par )
748
749	!
750	!-- Set flag that indicates that the new module is switched on
751	!-- Note that this parameter needs to be declared in modules.f90
752	new_module = .TRUE.
753
754	10 CONTINUE
755
756	END SUBROUTINE newmodule_parin
757
758
759	!------------------------------------------------------------------------------!
760	! Description:
761	! ------------
762	!> Swapping of timelevels
763	!------------------------------------------------------------------------------!
764	SUBROUTINE newmodule_swap_timelevel ( mod_count )
765
766	IMPLICIT NONE
767
768	INTEGER, INTENT(IN) :: mod_count !<
769
770	!
771	!-- Example for prognostic variable "prog_var"
772	#if defined( __nopointer )
773	!
774	! prog_var = prog_var_p
775	!
776	#else
777	!
778	! SELECT CASE ( mod_count )
779	!
780	! CASE ( 0 )
781	!
782	! prog_var => prog_var_1; prog_var_p => prog_var_2
783	!
784	! CASE ( 1 )
785	!
786	! prog_var => prog_var_2; tprog_var_p => prog_var_1
787	!
788	! END SELECT
789	#endif
790
791	END SUBROUTINE newmodule_swap_timelevel
792
793
794	!------------------------------------------------------------------------------!
795	! Description:
796	! ------------
797	!> This routine reads the respective restart data.
798	!------------------------------------------------------------------------------!
799	SUBROUTINE newmodule_read_restart_data
800
801
802	IMPLICIT NONE
803
804	CHARACTER (LEN=30) :: variable_chr !< dummy variable to read string
805
806
807	READ ( 13 ) variable_chr
808	DO WHILE ( TRIM( variable_chr ) /= '* end new module *' )
809
810	SELECT CASE ( TRIM( variable_chr ) )
811
812	! CASE ( 'param1' )
813	! IF ( .NOT. ALLOCATED( param1 ) ) ALLOCATE( param1(...) )
814	! READ ( 13 ) param1
815
816	END SELECT
817
818	READ ( 13 ) variable_chr
819
820	ENDDO
821
822	END SUBROUTINE newmodule_read_restart_data
823
824
825	!------------------------------------------------------------------------------!
826	! Description:
827	! ------------
828	!> This routine writes the respective restart data.
829	!------------------------------------------------------------------------------!
830	SUBROUTINE newmodule_last_actions
831
832	IMPLICIT NONE
833
834	! WRITE ( 14 ) 'param1 '
835	! WRITE ( 14 ) param1
836
837
838	WRITE ( 14 ) '* end new module * '
839
840	END SUBROUTINE newmodule_last_actions
841
842
843	!------------------------------------------------------------------------------!
844	! Description:
845	! ------------
846	!> Skipping of parameters from restart file (binary format).
847	!------------------------------------------------------------------------------!
848	SUBROUTINE newmodule_skip_var_list
849
850	IMPLICIT NONE
851
852	CHARACTER (LEN=1) :: param2 !<
853	CHARACTER (LEN=30) :: variable_chr !<
854
855	READ ( 13 ) variable_chr
856	DO WHILE ( TRIM( variable_chr ) /= '* end new module *' )
857	READ ( 13 ) param2
858	ENDDO
859
860	END SUBROUTINE newmodule_skip_var_list
861
862
863	!------------------------------------------------------------------------------!
864	! Description:
865	! ------------
866	!> Module-specific routine for new module
867	!------------------------------------------------------------------------------!
868	SUBROUTINE newmodule_newprocedure
869
870	!
871	!-- New subroutine goes here
872	!-- ...
873
874	END SUBROUTINE newmodule_newprocedure
875
876
877	END MODULE newmodule_mod

Download in other formats:

Original Format