source: trunk/SOURCES/relaxation_water_diffusion.f90 @ 334

Last change on this file since 334 was 196, checked in by aquiquet, 6 years ago

Small changes to make the model compatible with the ifort fpe0 flag

File size: 6.4 KB
Line 
1!> \file relaxation_water_diffusion.f90
2!! Module pour la resolution de l'equation de relaxation et de l equation de diffusion.
3!<
4
5!> \namespace relaxation_waterdif_mod
6!! Module pour la resolution de l'equation de relaxation et de l equation de diffusion .
7!! \author ...
8!! \date ...
9!! @note dhwat/dt = bmelt-infiltr-d/dx(Kond*dhwat/dx)+d/dx(Kond*pgx)
10!<
11module relaxation_waterdif_mod
12
13
14
15
16CONTAINS
17
18
19subroutine relaxation_waterdif(NXX,NYY,DT,DX,vieuxHWATER,limit_hw,klimit,BMELT,INFILTR,PGMX,PGMY,KOND,HWATER)
20
21  !$ USE OMP_LIB
22
23  implicit none
24
25
26    ! declaration des variables en entree
27    !------------------------------------------------
28    INTEGER, intent(in) :: NXX, NYY       !< defini la taille des tableaux
29    REAL,    intent(in) ::  DT            !< pas de temps court
30    REAL,    intent(in) ::  DX            !< pas en x
31    REAL,    intent(in) :: INFILTR        !< basal infiltration (lose of water)
32
33    REAL,dimension(NXX,NYY), intent(in) :: limit_hw    !< conditions aux limites
34    integer,dimension(NXX,NYY), intent(in) :: klimit    !< ou appliquer les conditions
35    REAL,dimension(NXX,NYY), intent(in) :: vieuxHWATER    !< H au pas de temps precedent 'o'
36    REAL,dimension(NXX,NYY), intent(in) :: BMELT     !< basal melting  'o'
37    REAL,dimension(NXX,NYY), intent(in) :: PGMX     !< hydaulic potential gratient '>'
38    REAL,dimension(NXX,NYY), intent(in) :: PGMY     !< hydaulic potential gratient '^'
39    REAL,dimension(NXX,NYY), intent(in) :: KOND     !< hydaulic conductivity 'o'
40
41    ! declaration des variables en sortie
42    !-------------------------------------
43    REAL,dimension(NXX,NYY), intent(out):: HWATER      !< basal water thickness  'o' (pressure equivalent)
44
45
46    ! declaration des variables locales
47    !----------------------------------
48    INTEGER :: I,J
49    REAL  :: TESTH 
50    REAL,dimension(NXX,NYY) :: ARELAX,BRELAX,CRELAX,DRELAX,ERELAX,FRELAX
51    REAL,dimension(NXX,NYY) :: DELTAH
52    REAL :: RESTE,DELH,VH
53    INTEGER :: ntour
54    REAL  :: DTSRGDX,dtwdx2
55    LOGICAL :: STOPP
56    REAL,dimension(NXX,NYY) :: KMX, KMY
57    !    REAL  :: RHO,RHOW,RHOG  !,SECYEAR!! ice density, water density, density*acceleration
58!    write(6,*) 'entree relaxation'
59
60! write(166,*)' entree  relaxation waterdif'
61!$OMP PARALLEL
62!$OMP WORKSHARE
63    HWATER(:,:)= vieuxHWATER(:,:)
64!$OMP END WORKSHARE
65    !   calcul de kmx et kmx a partir de KOND
66    !   conductivite hyrdraulique sur les noeuds mineurs
67    !   moyenne harmonique
68    !   ----------------------------------------
69!$OMP DO
70    do j=2,nyy
71       do i=2,nxx
72
73          if  ((kond(i,j).lt.1.e-20).or.(kond(i-1,j).lt.1.e-20)) then
74             kmx(i,j)=0. ! to avoid division by o
75          else
76             kmx(i,j)=2*(kond(i,j)*kond(i-1,j))/(kond(i,j)+kond(i-1,j))
77          endif
78
79       end do
80    end do
81!$OMP END DO
82
83!$OMP DO
84    do j=2,nyy
85       do i=2,nxx
86          if  ((kond(i,j).lt.1.e-20).or.(kond(i,j-1).lt.1.e-20)) then
87             kmy(i,j)=0. ! to avoid division by o
88          else
89             kmy(i,j)=2*(kond(i,j)*kond(i,j-1))/(kond(i,j)+kond(i,j-1))
90          endif
91
92       enddo
93    enddo
94!$OMP END DO
95
96    !   attribution des coefficients  arelax ....
97    !   ----------------------------------------
98    !    SECYEAR=365.*24.*3600.
99    !   rho=910.
100    !    rhow=1000.
101    !    rhog=rhow*9.81
102    !    dtsrgdx=dt/(rhog*DX) a mon avis c'est rhow qu'il fallait utiliser. Maintenant cette
103    !    division est faite dans eaubasale
104
105    dtsrgdx=dt/DX
106    dtwdx2=dt/dx/dx
107
108!$OMP WORKSHARE
109  deltah(:,:)=0.
110  arelax(:,:)=0.
111  brelax(:,:)=0.
112  crelax(:,:)=1.
113  drelax(:,:)=0.
114  erelax(:,:)=0.
115  frelax(:,:)=limit_hw(:,:)
116!$OMP END WORKSHARE
117  reste      =0.
118
119!$OMP DO
120    do J=2,NYY-1
121       do I=2,NXX-1
122
123          if (klimit(i,j).eq.0) then
124! calcul du vecteur
125          FRELAX(I,J)= VIEUXHWATER(I,J)+(BMELT(I,J)-INFILTR)*DT
126          frelax(i,j)=frelax(i,j)+(kmx(i,j)*pgmx(i,j)-kmx(i+1,j)*pgmx(i+1,j))*dtsrgdx
127          frelax(i,j)=frelax(i,j)+(kmy(i,j)*pgmy(i,j)-kmy(i,j+1)*pgmy(i,j+1))*dtsrgdx
128! calcul des diagonales     
129          arelax(i,j)=-kmx(i,j)*dtwdx2        ! arelax : diagonale i-1,j
130
131          brelax(i,j)=-kmx(i+1,j)*dtwdx2      ! brelax : diagonale i+1,j
132
133          drelax(i,j)=-kmy(i,j)*dtwdx2        ! drelax : diagonale i,j-1
134         
135          erelax(i,j)=-kmy(i,j+1)*dtwdx2      ! drelax : diagonale i,j+1
136
137          crelax(i,j)=1.+((kmx(i,j)+kmx(i+1,j))+(kmy(i,j)+kmy(i,j+1)))*dtwdx2 
138                                              !crelax : diagonale i,j
139          else if (klimit(i,j).eq.1) then
140             hwater(i,j)=limit_hw(i,j)
141!             write(6,*) i,j,hwater(i,j),crelax(i,j),frelax(i,j),arelax(i,j)
142          endif
143       end do
144    end do
145!$OMP END DO
146!$OMP END PARALLEL
147
148    ! Boucle de relaxation :
149    ! ----------------------
150    STOPP = .false.
151
152    ntour=0
153    stopp=.false.
154    Do  WHILE(.NOT.STOPP)
155       ntour=ntour+1
156!       write(6,*) 'boucle de relaxation numero',ntour
157       !$OMP PARALLEL
158       !$OMP DO PRIVATE(reste)
159       do j=2,NYY-1
160          do i=2,NXX-1
161
162             RESTE = (((ARELAX(I,J)*HWATER(I-1,J) + BRELAX(I,J)*HWATER(I+1,J)) &
163                  + (DRELAX(I,J)*HWATER(I,J-1) + ERELAX(I,J)*HWATER(I,J+1))) &
164                  + CRELAX(I,J)*HWATER(I,J))- FRELAX(I,J)
165
166             DELTAH(I,J) = RESTE/CRELAX(I,J)             
167          end do
168       end do
169       !$OMP END DO
170
171       !$OMP WORKSHARE
172       deltah(:,:)=min(deltah(:,:),10.)
173       deltah(:,:)=max(deltah(:,:),-10.)
174       !$OMP END WORKSHARE
175       ! il faut faire le calcul suivant dans une autre boucle car RESTE est fonction
176       ! de hwater sur les points voisins.
177       !$OMP DO
178       do j=2,NYY-1
179          do i=2,NXX-1
180             HWATER(I,J) = HWATER(I,J) - DELTAH(I,J)
181          end do
182       end do
183       !$OMP END DO
184
185       ! critere d'arret:
186       Delh=0
187       Vh=0
188       
189       !$OMP DO REDUCTION(+:Delh)
190       DO j=2,NYY-1
191          DO i=2,NXX-1
192             
193             !   write(166,*) I,J,delh,deltah(i,j)
194             Delh=Delh+deltah(i,j)**2
195             !            Vh=Vh+h(i,j)**2.
196          END DO
197       END DO
198       !$OMP END DO
199       !$OMP END PARALLEL
200!       write(6,*) delh,maxval(deltah),minval(deltah)
201       !      testh=SQRT(Delh/Vh)
202       if (delh.gt.0.) then
203          testh=SQRT(Delh)/((NXX-2)*(NYY-2))
204       else
205          testh=0.
206       endif
207       STOPP = (testh.lt.1.E-3).or.(ntour.gt.1000)
208!       write(6,*) ntour,testh
209
210
211362   continue 
212end do
213  end subroutine relaxation_waterdif
214end module relaxation_waterdif_mod
Note: See TracBrowser for help on using the repository browser.