!> \file deformation_mod-0.3.f90 !! C'est ce module qui doit etre selectionne pour faire le calcul de la !! deformation de la glace en utilisant une loi de deformation de corps !! visqueux non newtonnien. !< !> \namespace deformation_mod !!C'est ce module qui doit etre selectionne pour faire le calcul de la !!deformation de la glace en utilisant une loi de deformation de corps !!visqueux non newtonnien. !! \author CatRitz !! \date decmebre 1999 !!@note Ce module contient la routine d'initialisation des variables utilisees !! pour la deformation. !! @note Used modules !! @note - use deform_declar !< module DEFORMATION_MOD use DEFORM_DECLAR CONTAINS !> SUBROUTINE: init_deformation !!Routine qui initialise les variables et alloue les tableaux qui !!@note interviennent dans la loi de deformation !!@note Used modules !!@note use module3D_phy !> SUBROUTINE INIT_DEFORMATION USE module3D_phy implicit none REAL,dimension(NZ) :: EDECAL ! tableau de travail (decalage de E de 1 indice) ! tous les tableaux qui dependent de la loi de deformation sont allocatable. ! L'allocation se fait juste apres avoir determiner le nombre d'exposants ! differents utilises. !************ allocation des tableaux ********************* if (.not.allocated(BTT)) THEN allocate(BTT(NX,NY,NZ,n1poly:n2poly),stat=err) if (err/=0) then print *,"Erreur a l'allocation du tableau BTT",err stop 4 end if end if if (.not.allocated(SA)) THEN allocate(SA(NX,NY,NZ,n1poly:n2poly),stat=err) if (err/=0) then print *,"Erreur a l'allocation du tableau SA",err stop 4 end if end if if (.not.allocated(SA_mx)) THEN allocate(SA_mx(NX,NY,NZ,n1poly:n2poly),stat=err) if (err/=0) then print *,"Erreur a l'allocation du tableau SA_mx",err stop 4 end if end if if (.not.allocated(SA_my)) THEN allocate(SA_my(NX,NY,NZ,n1poly:n2poly),stat=err) if (err/=0) then print *,"Erreur a l'allocation du tableau SA_my",err stop 4 end if end if if (.not.allocated(S2A)) THEN allocate(S2A(NX,NY,NZ,n1poly:n2poly),stat=err) if (err/=0) then print *,"Erreur a l'allocation du tableau S2A",err stop 4 end if end if if (.not.allocated(S2A_mx)) THEN allocate(S2A_mx(NX,NY,NZ,n1poly:n2poly),stat=err) if (err/=0) then print *,"Erreur a l'allocation du tableau S2A_mx",err stop 4 end if end if if (.not.allocated(S2A_my)) THEN allocate(S2A_my(NX,NY,NZ,n1poly:n2poly),stat=err) if (err/=0) then print *,"Erreur a l'allocation du tableau S2A_my",err stop 4 end if end if if (.not.allocated(SF)) THEN allocate(SF(n1poly:n2poly),stat=err) if (err/=0) then print *,"Erreur a l'allocation du tableau SF",err stop 4 end if end if if (.not.allocated(Q1)) THEN allocate(Q1(n1poly:n2poly),stat=err) if (err/=0) then print *,"Erreur a l'allocation du tableau Q1",err stop 4 end if end if if (.not.allocated(Q2)) THEN allocate(Q2(n1poly:n2poly),stat=err) if (err/=0) then print *,"Erreur a l'allocation du tableau Q2",err stop 4 end if end if if (.not.allocated(BAT1)) THEN allocate(BAT1(n1poly:n2poly),stat=err) if (err/=0) then print *,"Erreur a l'allocation du tableau BAT1",err stop 4 end if end if if (.not.allocated(BAT2)) THEN allocate(BAT2(n1poly:n2poly),stat=err) if (err/=0) then print *,"Erreur a l'allocation du tableau BAT2",err stop 4 end if end if if (.not.allocated(glen)) THEN allocate(glen(n1poly:n2poly),stat=err) if (err/=0) then print *,"Erreur a l'allocation du tableau glen",err stop 4 end if end if if (.not.allocated(TTRANS)) THEN allocate(TTRANS(n1poly:n2poly),stat=err) if (err/=0) then print *,"Erreur a l'allocation du tableau TTRANS",err stop 4 end if end if if (.not.allocated(DDX)) THEN allocate(DDX(NX,NY,n1poly:n2poly),stat=err) if (err/=0) then print *,"Erreur a l'allocation du tableau DDX",err stop 4 end if end if if (.not.allocated(DDY)) THEN allocate(DDY(NX,NY,n1poly:n2poly),stat=err) if (err/=0) then print *,"Erreur a l'allocation du tableau DDY",err stop 4 end if end if !************* FIN DE L'ALLOCATION DES TABLEAUX ************* !************** COEFFICIENTS DES LOIS DE COMPORTEMENT ******** glen(1) = 3. ! LOI DE GLEN glen(2) = 1. ! LOI LINEAIRE !********* INITIALISATION DES LOIS DE DEFORMATION ************** ! ************** FLOW LAW COEFFICIENT LOI DE GLEN ************** ! softening factor for flow law if ((GEOPLACE.eq.'eismint').and.(ICOUPLE.eq.2)) then if (IMARGIN.eq.0) then SF(1)=3.52 ! coefficient multiplicateur else SF(1)=1.745 endif else if ((GEOPLACE(1:6).eq.'marine') & .and.(GEOPLACE.ne.'marine0')) then ! SF(1)=6. SF(1)=1. ! SF(1)=0.4 else SF(1)=3. endif ! arrhenius constants /Pa3/a, J/mol ! A0=1.E-16 initialise dans flowlawcoefbis if (icouple.eq.4) then ! idem these catritz SF(1)=3. ! SF(1)=1. ! SF(1)=0.4 ! BAT1(1)=0. BAT1(1)=0.166e-15 ! fluidite Newtonienne T < TTRANS(1) Q1(1)=78.2e+3 ! energie d'activation T < TTRANS(1) BAT2(1)=0.2e-15 ! fluidite Newtonienne T > TTRANS(1) Q2(1)=95.45e+3 ! energie d'activation T > TTRANS(1) ! temperature de transition entre les deux lois en deg Celsius TTRANS(1)=-6.5 else ! idem P. Huybrechts SF(1)=5. ! pour run Antarctique Grounded ou level 3a BAT1(1)=7.65e-17 Q1(1)=60.e+3 BAT2(1)=0.28642e-15 Q2(1)=139.e+3 ! temperature de transition entre les deux lois en deg Celsius TTRANS(1)=-10. endif !************* LINEAR FLOW LAW COEFFICIENT *************** ! temperature de transition entre les deux lois en deg Celsius TTRANS(2)=-10. ! SF(2)=0. SF(2)=1. ! SF(2)=3. ! SF(2)=6. ! coefficient multiplicateur ! Pour les temperatures inferieures a TTRPHI BAT1(2)=8.313e-8 ! fluidite Newtonienne Q1(2)=40.e+3 ! energie d'activation ! Pour les temperatures superieures a TTRPHI BAT2(2)=0. ! fluidite Newtonienne BAT2(2)=BAT1(2) ! attention rajouté pour l'ice shelf ! Q2(2)=SPHI*8.313e-8 Q2(2)=60.e+3 ! energie d'activation !********* gas constant (J/mol/K) ************ RGAS=8.314 !************* INITIALISATION DE DDX ET DDY ***************** DDX(:,:,:)=0. DDY(:,:,:)=0. write(num_rep_42,*) 'Loi de deformation n, sf, ttrans, bat1, Q1, bat2, Q2' do iglen=1,2 write(num_rep_42,fmt=123) int(glen(iglen)), sf(iglen), ttrans(iglen),bat1(iglen), & Q1(iglen), bat2(iglen), Q2(iglen) 123 format(i2,1x,f0.2,1x,f0.3,1x,4(es10.3,1x)) ! application des sf bat1(iglen)=bat1(iglen)*sf(iglen) bat2(iglen)=bat2(iglen)*sf(iglen) end do END SUBROUTINE INIT_DEFORMATION END MODULE DEFORMATION_MOD