source: branches/GRISLIv3/SOURCES/main3D-0.4-40km.f90 @ 476

Last change on this file since 476 was 476, checked in by aquiquet, 5 months ago

Cleaning branch: ablation_bord with explicit arguments

File size: 8.8 KB
Line 
1!     **********************************************************************
2!     *       GRISLI      Grenoble Ice Shelves-Land Ice
3!     **********************************************************************
4
5
6!     Ont participe a l'ecriture de ce modele :
7!
8!                   Catherine Ritz                           (tout du long)
9!                   Adeline Fabre                      (la partie Gremlins)
10!                   Vincent Rommelaere         (ice shelves et ice streams)
11!                   Christophe Dumas (debut f90,              (Antarctique)
12!                   Vincent Peyaud      (portage HN,calving, front, hydrol)
13!                   Cyril Mazauric                                  (AGRIF)
14!                   Hassine Baya             (netcdf, doxygen, icetemp,...)
15!
16!     catritz@lgge.obs.ujf-grenoble.fr
17!
18!     **********************************************************************
19
20
21
22!> \mainpage GRISLI Modele 3D De Calotte Glaciaire
23!!
24!! \section start Pour commencer
25!! Le programme principal est dans le module main3D.
26!! Ce module est dans le fichier  main3D-0.4-40km.f90.
27!!
28!! \section tree Arbre d'appel
29!!
30!! - call grisli_init()
31!!   - step_grisli()
32!!   - sortie_ncdf_cat()
33!!   - testsort_time_ncdf()
34!!   - initial()
35!!   - sortie_hz_multi()
36!! - call step_grisli1()
37!!
38!<
39
40
41!> \file main3D-0.4-40km.f90 GRISLI Modele 3D De Calotte Glaciaire
42!! programme principal
43!! (voir l'\ref tree)
44!!
45!! @brief   modele flow line d'evolution de calotte
46!! @authors         Catherine Ritz     catritz@lgge.obs.ujf-grenoble.fr  (tout du long)
47!! @authors         Adeline Fabre                      (la partie Gremlins)
48!! @authors         Vincent Rommelaere         (ice shelves et ice streams)
49!! @authors         Christophe Dumas (debut f90,              (Antarctique)
50!! @authors         Vincent Peyaud      (portage HN,calving, front, hydrol)
51!! @authors         Cyril Mazauric                                  (AGRIF)
52!!
53!!
54!! @note use module3D_phy
55!! @note use module_choix
56!! @note use flottab_mod
57!! @note use icetempmod
58!! @note use sorties_ncdf_grisli
59!! @note use diagno_mod
60!! @note use resolmeca_SIA_L1
61!!
62!!
63!! Ce module appelle les routines suivantes :
64!! - grisli_init()
65!! - step_grisli1()
66!! - step_output()
67!!
68!<
69
70!> \namespace main3D GRISLI Modele 3D De Calotte Glaciaire
71!! programme principal
72!! (voir l'\ref tree)
73!!
74!!
75!! @brief   modele flow line d'evolution de calotte
76!! @authors         Catherine Ritz     catritz@lgge.obs.ujf-grenoble.fr  (tout du long)
77!! @authors         Adeline Fabre                      (la partie Gremlins)
78!! @authors         Vincent Rommelaere         (ice shelves et ice streams)
79!! @authors         Christophe Dumas (debut f90,              (Antarctique)
80!! @authors         Vincent Peyaud      (portage HN,calving, front, hydrol)
81!! @authors         Cyril Mazauric                                  (AGRIF)
82!!
83!!
84!! @note use module3D_phy
85!! @note use module_choix
86!! @note use flottab_mod
87!! @note use icetempmod
88!! @note use sorties_ncdf_grisli
89!! @note use diagno_mod
90!! @note use resolmeca_SIA_L1
91!!
92!!
93!! @todo itracebug : faire une routine
94!!
95!! Ce module appelle les routines suivantes :
96!! - grisli_init()
97!! - step_grisli1()
98!!
99!! Defined in file main3D-0.4-40km.f90
100!<
101
102program main3D
103
104  use module3D_phy, only: time,iout,ntmax
105  use runparam, only: tend,itracebug,nt
106
107  implicit none
108
109
110  ! good luck
111
112  call grisli_init  ! Initializations
113
114  time_loop: do nt=1,ntmax         !____________________________ debut boucle temporelle
115
116     if (time.ge.tend) exit
117     if (time.gt.10) itracebug = 0
118     call step_time_loop()
119
120  end do time_loop
121  if (itracebug.eq.1)  call tracebug('dans main avant call out_recovery ')
122  call out_recovery(iout)
123
124  write(6,*) "end of the run at time = ",time
125  write(6,*) "_____________________________________________________________________"
126
127end program main3D
128
129
130!---------------------------------------------------------------------------------------
131subroutine grisli_init
132
133  USE module3D_phy, only: itemp,icouple,isynchro,icompteur,iglen, &
134                          ice,bm,bmelt,ablbord,ablbord_dtt,dt,    &
135                          s,h,b,bsoc,flot,mk,mk0,uxbar,uybar,hwater,time,timemax,ndebug,ndebug_max
136  use runparam, only: nt,tbegin,dtprofile,dtcpt,dirnameout,runname,itracebug
137  use geography, only: nx,ny,geoplace
138  use deformation_mod_2lois, only:n1poly,n2poly
139  use bilan_eau_mod, only: init_bilan_eau
140  use module_choix, only: forclim,ablation,bmeltshelf,calving,flow_general,flowlaw
141  !  module_choix donne acces a tous les modules
142  !  de declaration des packages
143  use flottab_mod, only: flottab
144  use sorties_ncdf_grisli, only: iglob_ncdf,testsort_time_ncdf,init_sortie_ncdf,testsort_time_ncdf, &
145                                 sortie_ncdf_cat
146  use util_recovery, only: dtout
147 
148!  use track_debug
149
150  implicit none
151
152  integer :: i,j
153
154  if (itracebug.eq.1)  call tracebug(' Entree dans routine grisli_init')
155  !      switch pour passer ou non par T lliboutry calcule => 0, ne passe pas,
156  !      1 ou 2 passe (se met a 0 tout seul si on prend un fichier .cptr)
157
158  ITEMP=0
159
160  !      switch couple physique faible =>  CP et CT independant T
161  !               0     pas de trait. vert.  A FAIRE           niveau L0
162  !               1     pas de couplage , faible physique      niveau L1
163  !               2     couplage, faible physique              niveau L2
164  !               3     couplage, physique complete sans CBT   niveau L3
165  !               4     idem 3 mais loi de def. Duval          niveau L4
166  ICOUPLE=4
167
168  nt=-1   ! utilisee dans initialisation flottab
169  !     sortie profile tous les dtprofile
170  DTPROFILE=50000.
171  !     ----------------------------------fin des modifs run les plus usuelles
172  DIRNAMEOUT='../RESULTATS/'
173  !DIRNAMEOUT='./'
174
175  call initial  ! routine qui appel toutes les routines d'initialisation
176
177
178  !      call init_sortie_ncdf
179  !      call sortie_ncdf_cat
180  !      STOP
181
182  !     compteur tous les DTCPT
183  DTCPT=dtout
184
185  !------------------------------ INITIALISATION ----------------------------
186  !
187! ecriture netcdf apres initialisation
188
189
190
191  call testsort_time_ncdf(dble(tbegin))
192  if (iglob_ncdf .EQ. 1) call sortie_ncdf_cat
193
194  ! test vincent car certains H(i,j)=0 dans fichier de reprise
195  do j=1,ny
196     do i=1,nx
197        H(i,j)=max(0.,H(i,j))
198     enddo
199  enddo
200
201
202  call forclim                   !  initialisation BM et TS         
203  call ablation
204
205
206
207  !  -----------                  CALCULATION OF INITIAL TEMPERATURES
208
209  tcpt:if (ICOMPTEUR.eq.0) then
210
211
212
213        if ((ITEMP.eq.0).or.(ITEMP.eq.3)) then
214           call masque(flot,mk,mk0,itracebug)
215
216           call Neffect()
217
218           call flottab()
219
220           call Neffect()
221
222
223           !          call vitbilan_lect   ! routine de lecture des vitesses de bilan
224           !       ========================================================
225
226           if (ITEMP.eq.0) call lineartemp()
227
228           call bmelt_grounded 
229           call  bmeltshelf
230
231
232           call flow_general
233
234           do iglen=n1poly,n2poly
235              call flowlaw(iglen)
236           end do
237
238           call Neffect()
239           call flottab()
240           call calving
241           call ablation_bord(ice,bm,bmelt,ablbord,ablbord_dtt,dt)
242           call flottab
243           call Neffect()
244           call diffusiv()
245           call SIA_velocities()
246        endif
247
248  else  ! tcpt     on reprend un fichier compteur (ICOMPTEUR.eq.1)
249
250     time=tbegin       ! prend le temps du compteur
251
252
253     call masque(flot,mk,mk0,itracebug)
254     call flottab()
255     call neffect()
256     call flottab()
257     call masque(flot,mk,mk0,itracebug)
258
259     do i=1,nx
260        do j=1,ny
261           if (S(i,j).lt.0) then
262              print*,i,j,S(i,j)
263              goto 11115
264           endif
265        enddo
266     enddo
26711115 continue
268
269     call  bmeltshelf ! afq --
270
271     !       ========================================================
272     call flow_general
273
274     do iglen=n1poly,n2poly
275        call flowlaw(iglen)
276     end do
277
278
279     call Neffect()
280     call flottab
281     call diffusiv()
282     call SIA_velocities()
283     call strain_rate
284
285  endif tcpt
286  !     fin du test sur icompteur
287
288  !      call init_sortie_ncdf
289  !      call sortie_ncdf_cat
290
291  call flottab()
292  call Neffect()
293  call flottab()
294
295  if (icompteur.eq.0) then
296     do i=1,nx
297        do j=1,ny
298           if (.not.flot(i,j)) then
299              B(i,j) = Bsoc(i,j)
300              Uxbar(i,j) = 0.
301              Uybar(i,j) = 0.
302           end if
303        end do
304     end do
305  endif
306
307  do i=2,nx-1
308     do j=2,ny-1
309        hwater(i,j)=max(hwater(i,j),0.)
310     enddo
311  enddo
312  timemax=time
313  isynchro=1
314  ndebug=0
315  ndebug_max=9
316
317  call init_bilan_eau
318  call step_thermomeca()     ! un tour dans la boucle temporelle, partie avant icethick
319  call init_sortie_ncdf
320  if (itracebug.eq.1)  call tracebug(' fin routine grisli_init')
321  call testsort_time_ncdf(dble(tbegin))
322
323  if (iglob_ncdf .EQ. 1) call sortie_ncdf_cat
324
325  return
326end subroutine grisli_init
Note: See TracBrowser for help on using the repository browser.