A Modular Arbitrary-Order Ocean-Atmosphere Model -- Stochastic implementation
ic_def.f90
Go to the documentation of this file.
1 
2 ! ic_def.f90
3 !
4 !> Module to load the initial condition.
5 !
6 !> @copyright
7 !> 2016 Lesley De Cruz, Jonathan Demaeyer & Sebastian Schubert
8 !> See LICENSE.txt for license information.
9 !
10 !---------------------------------------------------------------------------!
11 
12 MODULE ic_def
13 
14  USE params, only: natm,noc,ndim
15  USE util, only: str,rstr,init_random_seed
17  IMPLICIT NONE
18 
19  PRIVATE
20 
21  LOGICAL :: exists !< Boolean to test for file existence.
22 
23  REAL(KIND=8), DIMENSION(:), ALLOCATABLE, PUBLIC :: ic !< Initial condition vector
24 
25  PUBLIC ::load_ic
26 
27 CONTAINS
28 
29  !> Subroutine to load the initial condition if IC.nml exists.
30  !> If it does not, then write IC.nml with 0 as initial condition.
31  SUBROUTINE load_ic
32  INTEGER :: i,AllocStat,j
33  CHARACTER(len=20) :: fm
34  REAL(KIND=8) :: size_of_random_noise
35  INTEGER, DIMENSION(:), ALLOCATABLE :: seed
36  CHARACTER(LEN=4) :: init_type
37  namelist /iclist/ ic
38  namelist /rand/ init_type,size_of_random_noise,seed
39 
40 
41  fm(1:6)='(F3.1)'
42 
43  CALL random_seed(size=j)
44 
45  IF (ndim == 0) stop "*** Number of dimensions is 0! ***"
46  ALLOCATE(ic(0:ndim),seed(j), stat=allocstat)
47  IF (allocstat /= 0) stop "*** Not enough memory ! ***"
48 
49  INQUIRE(file='./IC.nml',exist=exists)
50 
51  IF (exists) THEN
52  OPEN(8, file="IC.nml", status='OLD', recl=80, delim='APOSTROPHE')
53  READ(8,nml=iclist)
54  READ(8,nml=rand)
55  CLOSE(8)
56  SELECT CASE (init_type)
57  CASE ('seed')
58  CALL random_seed(put=seed)
59  CALL random_number(ic)
60  ic=2*(ic-0.5)
61  ic=ic*size_of_random_noise*10.d0
62  ic(0)=1.0d0
63  WRITE(6,*) "*** IC.nml namelist written. Starting with 'seeded' random initial condition !***"
64  CASE ('rand')
65  CALL init_random_seed()
66  CALL random_seed(get=seed)
67  CALL random_number(ic)
68  ic=2*(ic-0.5)
69  ic=ic*size_of_random_noise*10.d0
70  ic(0)=1.0d0
71  WRITE(6,*) "*** IC.nml namelist written. Starting with random initial condition !***"
72  CASE ('zero')
73  CALL init_random_seed()
74  CALL random_seed(get=seed)
75  ic=0
76  ic(0)=1.0d0
77  WRITE(6,*) "*** IC.nml namelist written. Starting with initial condition in IC.nml !***"
78  CASE ('read')
79  CALL init_random_seed()
80  CALL random_seed(get=seed)
81  ic(0)=1.0d0
82  ! except IC(0), nothing has to be done IC has already the right values
83  WRITE(6,*) "*** IC.nml namelist written. Starting with initial condition in IC.nml !***"
84  END SELECT
85  ELSE
86  CALL init_random_seed()
87  CALL random_seed(get=seed)
88  ic=0
89  ic(0)=1.0d0
90  init_type="zero"
91  size_of_random_noise=0.d0
92  WRITE(6,*) "*** IC.nml namelist written. Starting with 0 as initial condition !***"
93  END IF
94  OPEN(8, file="IC.nml", status='REPLACE')
95  WRITE(8,'(a)') "!------------------------------------------------------------------------------!"
96  WRITE(8,'(a)') "! Namelist file : !"
97  WRITE(8,'(a)') "! Initial condition. !"
98  WRITE(8,'(a)') "!------------------------------------------------------------------------------!"
99  WRITE(8,*) ""
100  WRITE(8,'(a)') "&ICLIST"
101  WRITE(8,*) " ! psi variables"
102  DO i=1,natm
103  WRITE(8,*) " IC("//trim(str(i))//") = ",ic(i)," ! typ= "&
104  &//awavenum(i)%typ//", Nx= "//trim(rstr(awavenum(i)&
105  &%Nx,fm))//", Ny= "//trim(rstr(awavenum(i)%Ny,fm))
106  END DO
107  WRITE(8,*) " ! theta variables"
108  DO i=1,natm
109  WRITE(8,*) " IC("//trim(str(i+natm))//") = ",ic(i+natm)," ! typ= "&
110  &//awavenum(i)%typ//", Nx= "//trim(rstr(awavenum(i)&
111  &%Nx,fm))//", Ny= "//trim(rstr(awavenum(i)%Ny,fm))
112  END DO
113 
114  WRITE(8,*) " ! A variables"
115  DO i=1,noc
116  WRITE(8,*) " IC("//trim(str(i+2*natm))//") = ",ic(i+2*natm)," ! Nx&
117  &= "//trim(rstr(owavenum(i)%Nx,fm))//", Ny= "&
118  &//trim(rstr(owavenum(i)%Ny,fm))
119  END DO
120  WRITE(8,*) " ! T variables"
121  DO i=1,noc
122  WRITE(8,*) " IC("//trim(str(i+noc+2*natm))//") = ",ic(i+2*natm+noc)," &
123  &! Nx= "//trim(rstr(owavenum(i)%Nx,fm))//", Ny= "&
124  &//trim(rstr(owavenum(i)%Ny,fm))
125  END DO
126 
127  WRITE(8,'(a)') "&END"
128  WRITE(8,*) ""
129  WRITE(8,'(a)') "!------------------------------------------------------------------------------!"
130  WRITE(8,'(a)') "! Initialisation type. !"
131  WRITE(8,'(a)') "!------------------------------------------------------------------------------!"
132  WRITE(8,'(a)') "! type = 'read': use IC above (will generate a new seed);"
133  WRITE(8,'(a)') "! 'rand': random state (will generate a new seed);"
134  WRITE(8,'(a)') "! 'zero': zero IC (will generate a new seed);"
135  WRITE(8,'(a)') "! 'seed': use the seed below (generate the same IC)"
136  WRITE(8,*) ""
137  WRITE(8,'(a)') "&RAND"
138  WRITE(8,'(a)') " init_type= '"//init_type//"'"
139  WRITE(8,'(a,d15.7)') " size_of_random_noise = ",size_of_random_noise
140  DO i=1,j
141  WRITE(8,*) " seed("//trim(str(i))//") = ",seed(i)
142  END DO
143  WRITE(8,'(a)') "&END"
144  WRITE(8,*) ""
145  CLOSE(8)
146 
147  END SUBROUTINE load_ic
148 END MODULE ic_def
Module to load the initial condition.
Definition: ic_def.f90:12
integer ndim
Number of variables (dimension of the model)
Definition: params.f90:85
integer noc
Number of oceanic basis functions.
Definition: params.f90:84
Utility module.
Definition: util.f90:12
subroutine, public init_random_seed()
Random generator initialization routine.
Definition: util.f90:64
Inner products between the truncated set of basis functions for the ocean and atmosphere streamfuncti...
Statistics accumulators.
Definition: stat.f90:14
character(len=40) function, public rstr(x, fm)
Convert a real to string with a given format.
Definition: util.f90:38
character(len=20) function, public str(k)
Convert an integer to string.
Definition: util.f90:31
type(ocean_wavenum), dimension(:), allocatable, public owavenum
Oceanic blocs specification.
real(kind=8), dimension(:), allocatable, public ic
Initial condition vector.
Definition: ic_def.f90:23
type(atm_wavenum), dimension(:), allocatable, public awavenum
Atmospheric blocs specification.
integer natm
Number of atmospheric basis functions.
Definition: params.f90:83
The model parameters module.
Definition: params.f90:18
logical exists
Boolean to test for file existence.
Definition: ic_def.f90:21
subroutine, public load_ic
Subroutine to load the initial condition if IC.nml exists. If it does not, then write IC...
Definition: ic_def.f90:32