23 REAL(KIND=8),
DIMENSION(:),
ALLOCATABLE,
PUBLIC ::
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
38 namelist /rand/ init_type,size_of_random_noise,seed
43 CALL random_seed(size=j)
45 IF (
ndim == 0) stop
"*** Number of dimensions is 0! ***" 47 IF (allocstat /= 0) stop
"*** Not enough memory ! ***" 49 INQUIRE(file=
'./IC.nml',exist=
exists)
52 OPEN(8, file=
"IC.nml", status=
'OLD', recl=80, delim=
'APOSTROPHE')
56 SELECT CASE (init_type)
58 CALL random_seed(put=seed)
59 CALL random_number(
ic)
61 ic=
ic*size_of_random_noise*10.d0
63 WRITE(6,*)
"*** IC.nml namelist written. Starting with 'seeded' random initial condition !***" 66 CALL random_seed(get=seed)
67 CALL random_number(
ic)
69 ic=
ic*size_of_random_noise*10.d0
71 WRITE(6,*)
"*** IC.nml namelist written. Starting with random initial condition !***" 74 CALL random_seed(get=seed)
77 WRITE(6,*)
"*** IC.nml namelist written. Starting with initial condition in IC.nml !***" 80 CALL random_seed(get=seed)
83 WRITE(6,*)
"*** IC.nml namelist written. Starting with initial condition in IC.nml !***" 87 CALL random_seed(get=seed)
91 size_of_random_noise=0.d0
92 WRITE(6,*)
"*** IC.nml namelist written. Starting with 0 as initial condition !***" 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)')
"!------------------------------------------------------------------------------!" 100 WRITE(8,
'(a)')
"&ICLIST" 101 WRITE(8,*)
" ! psi variables" 103 WRITE(8,*)
" IC("//trim(
str(i))//
") = ",
ic(i),
" ! typ= "&
107 WRITE(8,*)
" ! theta variables" 109 WRITE(8,*)
" IC("//trim(
str(i+
natm))//
") = ",
ic(i+
natm),
" ! typ= "&
114 WRITE(8,*)
" ! A variables" 116 WRITE(8,*)
" IC("//trim(
str(i+2*
natm))//
") = ",
ic(i+2*
natm),
" ! Nx& 120 WRITE(8,*)
" ! T variables" 127 WRITE(8,
'(a)')
"&END" 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)" 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
141 WRITE(8,*)
" seed("//trim(
str(i))//
") = ",seed(i)
143 WRITE(8,
'(a)')
"&END" Module to load the initial condition.
integer ndim
Number of variables (dimension of the model)
integer noc
Number of oceanic basis functions.
subroutine, public init_random_seed()
Random generator initialization routine.
Inner products between the truncated set of basis functions for the ocean and atmosphere streamfuncti...
character(len=40) function, public rstr(x, fm)
Convert a real to string with a given format.
character(len=20) function, public str(k)
Convert an integer to string.
type(ocean_wavenum), dimension(:), allocatable, public owavenum
Oceanic blocs specification.
real(kind=8), dimension(:), allocatable, public ic
Initial condition vector.
type(atm_wavenum), dimension(:), allocatable, public awavenum
Atmospheric blocs specification.
integer natm
Number of atmospheric basis functions.
The model parameters module.
logical exists
Boolean to test for file existence.
subroutine, public load_ic
Subroutine to load the initial condition if IC.nml exists. If it does not, then write IC...