! ********************************************************************** ! * GRISLI Grenoble Ice Shelves-Land Ice ! ********************************************************************** ! Ont participe a l'ecriture de ce modele : ! ! Catherine Ritz (tout du long) ! Adeline Fabre (la partie Gremlins) ! Vincent Rommelaere (ice shelves et ice streams) ! Christophe Dumas (debut f90, (Antarctique) ! Vincent Peyaud (portage HN,calving, front, hydrol) ! Cyril Mazauric (AGRIF) ! Hassine Baya (netcdf, doxygen, icetemp,...) ! ! catritz@lgge.obs.ujf-grenoble.fr ! ! ********************************************************************** !> \mainpage GRISLI Modele 3D De Calotte Glaciaire !! !! \section start Pour commencer !! Le programme principal est dans le module main3D. !! Ce module est dans le fichier main3D-0.4-40km.f90. !! !! \section tree Arbre d'appel !! !! - call grisli_init() !! - step_grisli() !! - sortie_ncdf_cat() !! - testsort_time_ncdf() !! - initial() !! - sortie_hz_multi() !! - call step_grisli1() !! !< !> \file main3D-0.4-40km.f90 GRISLI Modele 3D De Calotte Glaciaire !! programme principal !! (voir l'\ref tree) !! !! @brief modele flow line d'evolution de calotte !! @authors Catherine Ritz catritz@lgge.obs.ujf-grenoble.fr (tout du long) !! @authors Adeline Fabre (la partie Gremlins) !! @authors Vincent Rommelaere (ice shelves et ice streams) !! @authors Christophe Dumas (debut f90, (Antarctique) !! @authors Vincent Peyaud (portage HN,calving, front, hydrol) !! @authors Cyril Mazauric (AGRIF) !! !! !! @note use module3D_phy !! @note use module_choix !! @note use flottab_mod !! @note use icetempmod !! @note use sorties_ncdf_grisli !! @note use diagno_mod !! @note use resolmeca_SIA_L1 !! !! !! Ce module appelle les routines suivantes : !! - grisli_init() !! - step_grisli1() !! - step_output() !! !< !> \namespace main3D GRISLI Modele 3D De Calotte Glaciaire !! programme principal !! (voir l'\ref tree) !! !! !! @brief modele flow line d'evolution de calotte !! @authors Catherine Ritz catritz@lgge.obs.ujf-grenoble.fr (tout du long) !! @authors Adeline Fabre (la partie Gremlins) !! @authors Vincent Rommelaere (ice shelves et ice streams) !! @authors Christophe Dumas (debut f90, (Antarctique) !! @authors Vincent Peyaud (portage HN,calving, front, hydrol) !! @authors Cyril Mazauric (AGRIF) !! !! !! @note use module3D_phy !! @note use module_choix !! @note use flottab_mod !! @note use icetempmod !! @note use sorties_ncdf_grisli !! @note use diagno_mod !! @note use resolmeca_SIA_L1 !! !! !! @todo itracebug : faire une routine !! !! Ce module appelle les routines suivantes : !! - grisli_init() !! - step_grisli1() !! !! Defined in file main3D-0.4-40km.f90 !< program main3D use module3D_phy, only: time,iout,ntmax use runparam, only: tend,itracebug,nt implicit none ! good luck call grisli_init ! Initializations time_loop: do nt=1,ntmax !____________________________ debut boucle temporelle if (time.ge.tend) exit if (time.gt.10) itracebug = 0 call step_time_loop() end do time_loop if (itracebug.eq.1) call tracebug('dans main avant call out_recovery ') call out_recovery(iout) write(6,*) "end of the run at time = ",time write(6,*) "_____________________________________________________________________" end program main3D !--------------------------------------------------------------------------------------- subroutine grisli_init USE module3D_phy, only: isynchro,icompteur,iglen, & ice,bm,bmelt,ablbord,ablbord_dtt,dt, & s,h,b,bsoc,flot,mk,mk0,uxbar,uybar,hwater,time,timemax,ndebug,ndebug_max use runparam, only: nt,tbegin,dtprofile,dtcpt,dirnameout,itracebug use geography, only: nx,ny,geoplace use deformation_mod_2lois, only:n1poly,n2poly use bilan_eau_mod, only: init_bilan_eau use module_choix, only: forclim,ablation,bmeltshelf,calving,flow_general,flowlaw ! module_choix donne acces a tous les modules ! de declaration des packages use flottab_mod, only: flottab use sorties_ncdf_grisli, only: iglob_ncdf,testsort_time_ncdf,init_sortie_ncdf,testsort_time_ncdf, & sortie_ncdf_cat use util_recovery, only: dtout ! use track_debug implicit none integer :: i,j if (itracebug.eq.1) call tracebug(' Entree dans routine grisli_init') ! switch pour passer ou non par T lliboutry calcule => 0, ne passe pas, ! 1 ou 2 passe (se met a 0 tout seul si on prend un fichier .cptr) nt=-1 ! utilisee dans initialisation flottab ! sortie profile tous les dtprofile DTPROFILE=50000. ! ----------------------------------fin des modifs run les plus usuelles DIRNAMEOUT='../RESULTATS/' !DIRNAMEOUT='./' call initial ! routine qui appel toutes les routines d'initialisation ! call init_sortie_ncdf ! call sortie_ncdf_cat ! STOP ! compteur tous les DTCPT DTCPT=dtout !------------------------------ INITIALISATION ---------------------------- ! ! ecriture netcdf apres initialisation call testsort_time_ncdf(dble(tbegin)) if (iglob_ncdf .EQ. 1) call sortie_ncdf_cat ! test vincent car certains H(i,j)=0 dans fichier de reprise do j=1,ny do i=1,nx H(i,j)=max(0.,H(i,j)) enddo enddo call forclim ! initialisation BM et TS call ablation ! ----------- CALCULATION OF INITIAL TEMPERATURES tcpt:if (ICOMPTEUR.eq.0) then call masque(flot,mk,mk0,itracebug) call Neffect() call flottab() call Neffect() ! call vitbilan_lect ! routine de lecture des vitesses de bilan ! ======================================================== call lineartemp() call bmelt_grounded call bmeltshelf call flow_general do iglen=n1poly,n2poly call flowlaw(iglen) end do call Neffect() call flottab() call calving call ablation_bord(ice,bm,bmelt,ablbord,ablbord_dtt,dt) call flottab call Neffect() call diffusiv() call SIA_velocities() else ! tcpt on reprend un fichier compteur (ICOMPTEUR.eq.1) time=tbegin ! prend le temps du compteur call masque(flot,mk,mk0,itracebug) call flottab() call neffect() call flottab() call masque(flot,mk,mk0,itracebug) do i=1,nx do j=1,ny if (S(i,j).lt.0) then print*,i,j,S(i,j) goto 11115 endif enddo enddo 11115 continue call bmeltshelf ! afq -- ! ======================================================== call flow_general do iglen=n1poly,n2poly call flowlaw(iglen) end do call Neffect() call flottab call diffusiv() call SIA_velocities() call strain_rate endif tcpt ! fin du test sur icompteur ! call init_sortie_ncdf ! call sortie_ncdf_cat call flottab() call Neffect() call flottab() if (icompteur.eq.0) then do i=1,nx do j=1,ny if (.not.flot(i,j)) then B(i,j) = Bsoc(i,j) Uxbar(i,j) = 0. Uybar(i,j) = 0. end if end do end do endif do i=2,nx-1 do j=2,ny-1 hwater(i,j)=max(hwater(i,j),0.) enddo enddo timemax=time isynchro=1 ndebug=0 ndebug_max=9 call init_bilan_eau call step_thermomeca() ! un tour dans la boucle temporelle, partie avant icethick call init_sortie_ncdf if (itracebug.eq.1) call tracebug(' fin routine grisli_init') call testsort_time_ncdf(dble(tbegin)) if (iglob_ncdf .EQ. 1) call sortie_ncdf_cat return end subroutine grisli_init