1 | PROGRAM rejouer |
---|
2 | |
---|
3 | USE mod_const_mpi, ONLY: comm_lmdz |
---|
4 | USE inigeomphy_mod, ONLY: inigeomphy |
---|
5 | USE comvert_mod, ONLY: presnivs |
---|
6 | USE comvert_mod, only : preff, pa |
---|
7 | USE ioipsl, only: getin |
---|
8 | |
---|
9 | |
---|
10 | |
---|
11 | |
---|
12 | implicit none |
---|
13 | INCLUDE "dimensions.h" |
---|
14 | |
---|
15 | real :: airefi |
---|
16 | real :: zcufi = 1. |
---|
17 | real :: zcvfi = 1. |
---|
18 | real :: rlat_rad(1),rlon_rad(1) |
---|
19 | |
---|
20 | integer ntime |
---|
21 | integer jour0,mois0,an0,day_step,anneeref,dayref |
---|
22 | integer klev,klon |
---|
23 | CHARACTER (len=10) :: calend |
---|
24 | CHARACTER(len=20) :: calendrier |
---|
25 | |
---|
26 | |
---|
27 | !--------------------------------------------------------------------- |
---|
28 | ! L'appel a inigeomphy n'est utile que pour avoir getin_p dans |
---|
29 | ! les initialisations |
---|
30 | !--------------------------------------------------------------------- |
---|
31 | zcufi=1. |
---|
32 | zcvfi=1. |
---|
33 | rlat_rad(1)=0. |
---|
34 | rlon_rad(1)=0. |
---|
35 | |
---|
36 | preff=101325. |
---|
37 | !preff=100000. |
---|
38 | pa=50000. |
---|
39 | CALL disvert() |
---|
40 | CALL inigeomphy(1,1,llm, & |
---|
41 | 1, comm_lmdz, & |
---|
42 | (/rlat_rad(1),0./),(/0./), & |
---|
43 | (/0.,0./),(/rlon_rad(1),0./), & |
---|
44 | (/ (/airefi,0./),(/0.,0./) /), & |
---|
45 | (/zcufi,0.,0.,0./), & |
---|
46 | (/zcvfi,0./)) |
---|
47 | |
---|
48 | CALL suphel |
---|
49 | !ntime=4320 |
---|
50 | ntime=10000000 |
---|
51 | dayref=1 |
---|
52 | anneeref=2000 |
---|
53 | call getin('dayref',dayref) |
---|
54 | call getin('anneeref',anneeref) |
---|
55 | call getin('calend',calend) |
---|
56 | call getin('day_step',day_step) |
---|
57 | calendrier=calend |
---|
58 | if ( calendrier == "earth_360d" ) calendrier="360_day" |
---|
59 | |
---|
60 | |
---|
61 | jour0=dayref |
---|
62 | mois0=(jour0-1)/30+1 |
---|
63 | jour0=jour0-30*((jour0-1)/30) |
---|
64 | an0=anneeref |
---|
65 | |
---|
66 | !print*,"REPLAY1D jour0,mois0,an0",jour0,mois0,an0 |
---|
67 | |
---|
68 | |
---|
69 | klon=1 |
---|
70 | klev=llm |
---|
71 | call iotd_ini('phys.nc',1,1,klev,0.,0.,presnivs,jour0,mois0,an0,0.,86400./day_step,calendrier) |
---|
72 | ! Consistent with ... CALL iophys_ini(600.) |
---|
73 | |
---|
74 | !--------------------------------------------------------------------- |
---|
75 | ! Initialisation de la parametrisation |
---|
76 | !--------------------------------------------------------------------- |
---|
77 | call call_ini_replay |
---|
78 | |
---|
79 | !--------------------------------------------------------------------- |
---|
80 | ! Boucle en temps sur l'appel à la parametrisation |
---|
81 | !--------------------------------------------------------------------- |
---|
82 | call call_param_replay(klon,klev) |
---|
83 | |
---|
84 | end |
---|
85 | |
---|
86 | !--------------------------------------------------------------------- |
---|
87 | !///////////////////////////////////////////////////////////////////// |
---|
88 | !///////////////////////////////////////////////////////////////////// |
---|
89 | ! routine additionnelles utiles, prises dans 1DUTILS.h |
---|
90 | !///////////////////////////////////////////////////////////////////// |
---|
91 | !///////////////////////////////////////////////////////////////////// |
---|
92 | !--------------------------------------------------------------------- |
---|
93 | |
---|
94 | !======================================================================= |
---|
95 | SUBROUTINE abort_gcm(modname, message, ierr) |
---|
96 | USE IOIPSL |
---|
97 | ! Stops the simulation cleanly, closing files and printing various |
---|
98 | ! comments |
---|
99 | !======================================================================= |
---|
100 | |
---|
101 | ! Input: modname = name of calling program |
---|
102 | ! message = stuff to print |
---|
103 | ! ierr = severity of situation ( = 0 normal ) |
---|
104 | |
---|
105 | character(len=*) modname |
---|
106 | integer ierr |
---|
107 | character(len=*) message |
---|
108 | |
---|
109 | write(*,*) 'in abort_gcm' |
---|
110 | call histclo |
---|
111 | write(*,*) 'out of histclo' |
---|
112 | write(*,*) 'Stopping in ', modname |
---|
113 | write(*,*) 'Reason = ',message |
---|
114 | call getin_dump |
---|
115 | |
---|
116 | if (ierr == 0) then |
---|
117 | write(*,*) 'Everything is cool' |
---|
118 | else |
---|
119 | write(*,*) 'Houston, we have a problem ', ierr |
---|
120 | endif |
---|
121 | STOP |
---|
122 | END |
---|
123 | |
---|
124 | !======================================================================= |
---|
125 | SUBROUTINE gr_dyn_fi(nfield,im,jm,ngrid,pdyn,pfi) |
---|
126 | IMPLICIT NONE |
---|
127 | ! passage d'un champ de la grille scalaire a la grille physique |
---|
128 | !======================================================================= |
---|
129 | |
---|
130 | !----------------------------------------------------------------------- |
---|
131 | ! declarations: |
---|
132 | ! ------------- |
---|
133 | |
---|
134 | INTEGER im,jm,ngrid,nfield |
---|
135 | REAL pdyn(im,jm,nfield) |
---|
136 | REAL pfi(ngrid,nfield) |
---|
137 | |
---|
138 | INTEGER j,ifield,ig |
---|
139 | |
---|
140 | !----------------------------------------------------------------------- |
---|
141 | ! calcul: |
---|
142 | ! ------- |
---|
143 | |
---|
144 | IF(ngrid/=2+(jm-2)*(im-1).AND.ngrid/=1) & |
---|
145 | STOP 'probleme de dim' |
---|
146 | ! traitement des poles |
---|
147 | CALL SCOPY(nfield,pdyn,im*jm,pfi,ngrid) |
---|
148 | CALL SCOPY(nfield,pdyn(1,jm,1),im*jm,pfi(ngrid,1),ngrid) |
---|
149 | |
---|
150 | ! traitement des point normaux |
---|
151 | DO ifield=1,nfield |
---|
152 | DO j=2,jm-1 |
---|
153 | ig=2+(j-2)*(im-1) |
---|
154 | CALL SCOPY(im-1,pdyn(1,j,ifield),1,pfi(ig,ifield),1) |
---|
155 | ENDDO |
---|
156 | ENDDO |
---|
157 | |
---|
158 | RETURN |
---|
159 | END |
---|