! ********************************************************************** ! * 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 USE module_choix ! module de choix du type de run ! module_choix donne acces a tous les modules ! de declaration des packages use flottab_mod use icetempmod use sorties_ncdf_grisli use diagno_mod use resolmeca_SIA_L1 use bilan_eau_mod ! use track_debug 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 USE module_choix ! module de choix du type de run ! module_choix donne acces a tous les modules ! de declaration des packages use flottab_mod use icetempmod use sorties_ncdf_grisli use util_recovery use diagno_mod ! use track_debug implicit none 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) ITEMP=0 ! switch couple physique faible => CP et CT independant T ! 0 pas de trait. vert. A FAIRE niveau L0 ! 1 pas de couplage , faible physique niveau L1 ! 2 couplage, faible physique niveau L2 ! 3 couplage, physique complete sans CBT niveau L3 ! 4 idem 3 mais loi de def. Duval niveau L4 ICOUPLE=4 ! switch margin IMARGIN=0 fixed, IMARGIN=1 moving IMARGIN=1 TIMECG=TBEGIN nt=-1 ! utilisee dans initialisation flottab ! sortie profile tous les dtprofile DTPROFILE=50000. marine=.true. ! ----------------------------------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 ! ************ OPEN FILES.RITZ **************** if ((geoplace.eq.'anteis1').or.(geoplace.eq.'ant20km')) then ! fichier de reference pour le niveau des mers open(num_sealevel,file=TRIM(DIRNAMEOUT)//'sealevel'//runname//'.ritz',position="append") open(num_ts_ritz,file=TRIM(DIRNAMEOUT)//'ts_'//runname//'.ritz',position="append") open(num_ic_vo,file=TRIM(DIRNAMEOUT)//'ic_'//runname//'vo.ritz',position="append") open(num_ic_by,file=TRIM(DIRNAMEOUT)//'ic_'//runname//'by.ritz',position="append") open(num_ic_dm,file=TRIM(DIRNAMEOUT)//'ic_'//runname//'dm.ritz',position="append") open(num_ic_dc,file=TRIM(DIRNAMEOUT)//'ic_'//runname//'dc.ritz',position="append") open(num_ic_df,file=TRIM(DIRNAMEOUT)//'ic_'//runname//'df.ritz',position="append") endif !------------------------------ INITIALISATION ---------------------------- ! ! ecriture netcdf apres initialisation call testsort_time_ncdf(dble(tbegin)) if (iglob_ncdf .EQ. 1) call sortie_ncdf_cat !cdc supprime pour initialisation propre !~ if (iter_beta.eq.0) then !~ if (itracebug.eq.1) call tracebug(' Avant appel routine icethick3') !~ call icethick3 !~ debug_3D(:,:,88) = S(:,:) !~ if (itracebug.eq.1) call tracebug(' Apres appel routine icethick3') !~ end if ! Tgrounded, temps pendant lequel la calotte est terrestre tgrounded=tbegin-10. !if (tgrounded.le.tbegin) then marine=.true. ! Cas la calotte est terrestre !end if ! 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 firstoutput() ! ouverture fichier temporel et premieres ecritures call forclim ! initialisation BM et TS call ablation ! ----------- CALCULATION OF INITIAL TEMPERATURES tcpt:if (ICOMPTEUR.eq.0) then if ((GEOPLACE.ne.'eismint').and.(GEOPLACE(1:6).ne.'marine')) then ! ITEMP=1 => calcul de T lliboutry; ITEMP=2 => reprise d'un fichier cptr ! ITEMP=0 => on ne prend pas en compte T Lliboutry ! ITEMP=3 => on prend les temperatures d'un fichier cptr if ((ITEMP.eq.0).or.(ITEMP.eq.3)) then call masque() call Neffect() call flottab() call Neffect() ! call vitbilan_lect ! routine de lecture des vitesses de bilan ! ======================================================== if (ITEMP.eq.0) 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 call flottab call Neffect() call diffusiv() call SIA_velocities() endif endif ! fin du test geoplace else ! tcpt on reprend un fichier compteur (ICOMPTEUR.eq.1) time=tbegin ! prend le temps du compteur call masque() call flottab() call neffect() call flottab() call masque() 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 boost = .false. 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 step_thermomeca() ! un tour dans la boucle temporelle, partie avant icethick call init_sortie_ncdf call init_bilan_eau 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