source: trunk/SOURCES/Snowball_files/lect-snowball_mod.f90

Last change on this file was 57, checked in by dumas, 8 years ago

Add Snowball configuration
File size: 7.1 KB
RevLine 
[57]1module lect_topo_snowball
2
3  use module3D_phy
4
5  character(len=100) :: topo_ref 
6  character(len=100) :: topo_dep
7  character(len=100) :: grid_topo
8  real :: toto
9
10  real :: correc_bathy
11
12contains
13
14  subroutine input_topo
15
16namelist/topo_file/topo_ref,topo_dep,grid_topo
17rewind(num_param)        ! pour revenir au debut du fichier param_list.dat
18read(num_param,topo_file)
19! formats pour les ecritures dans 42
20428 format(A)
21write(num_rep_42,428)'!___________________________________________________________' 
22write(num_rep_42,428) '&topo_file                                  ! nom du bloc '
23write(num_rep_42,*)
24write(num_rep_42,*) 'topo_ref = ', topo_ref
25write(num_rep_42,*) 'topo_dep = ', topo_dep
26write(num_rep_42,*) 'grid_topo = ', grid_topo
27write(num_rep_42,*)'/' 
28write(num_rep_42,428) '! topo_ref : topo ref isostasie'
29write(num_rep_42,428) '! topo_dep : topo de depart'
30write(num_rep_42,428) '! grid_topo : fichier i,j,x,y,lon,lat'
31write(num_rep_42,*)
32
33
34!    file1=TRIM(DIRNAMEINP)//'topo-toanor.g40' ! topo-maasnor.g40'     ! topo de depart
35!    file2=TRIM(DIRNAMEINP)//'topo-toanor.g40' !'topo-maasnor.g40'     ! topo de reference (isostasie)
36!    write(42,*) 'topo de depart', file1
37!    write(42,*) 'topo reference', file2
38
39
40
41    !     lecture de la topo de reference
42    !     ---------------------------
43    open (20,file=TRIM(DIRNAMEINP)//trim(topo_ref))
44
45    read(20,'(A80)') TITRE
46    read(20,*) NI,NJ,NXX,NYY,STEP
47    read(20,*)
48    do J=1,ny 
49       do I=1,nx
50          read (20,*)  toto,toto,BSOC0(I,J)
51          H0(i,j)=0.
52          S0(i,j)=max(BSOC0(i,j),0.)
53       end do
54    end do
55    close(20)
56! pour ne pas avoir de bathymetrie < -5000m
57!    where (BSOC0(:,:).LT.-5000) BSOC0(:,:)=-5000.
58
59
60    !     lecture de la topo de depart
61    !     ---------------------------
62    open (20,file=TRIM(DIRNAMEINP)//trim(topo_dep))
63    !         open (20,file='../INPUT-DATA/hemin.g50')
64    read(20,'(A80)') TITRE
65    read(20,*) NI,NJ,NXX,NYY,STEP
66    read(20,*)
67    do J=1,ny 
68       do I=1,nx
69          read (20,*) toto,toto,BSOC(I,J)
70          H(i,j)=0.
71          S(i,j)=max(BSOC(i,j),0.)
72          B(i,j)=S(i,j)-H(i,j)
73       end do
74    end do
75    close(20)
76! correction de la bathymetrie :
77    where (BSOC(:,:).LT.0.) BSOC(:,:)=-5000.
78
79
80    correc_bathy=0.
81    do j=2,ny-1
82       do i=2,nx-1
83          if (BSOC(i,j).LT.0.) THEN
84             if (BSOC(i+1,j).gt.correc_bathy.or.BSOC(i,j+1).gt.correc_bathy.or.BSOC(i-1,j).gt.correc_bathy.or.bsoc(i,j-1).gt.correc_bathy.or.bsoc(i+1,j+1).gt.correc_bathy.or.bsoc(i-1,j-1).gt.correc_bathy) then
85                BSOC(i,j)=-50.
86             endif
87          endif
88       enddo
89    enddo
90
91   
92    correc_bathy=-50.
93    do j=2,ny-1
94       do i=2,nx-1
95          if (BSOC(i,j).LT.correc_bathy) THEN
96             if (BSOC(i+1,j).eq.correc_bathy.or.BSOC(i,j+1).eq.correc_bathy.or.BSOC(i-1,j).eq.correc_bathy.or.bsoc(i,j-1).eq.correc_bathy.or.bsoc(i+1,j+1).eq.correc_bathy.or.bsoc(i-1,j-1).eq.correc_bathy) then
97                BSOC(i,j)=-200.
98             endif
99          endif
100       enddo
101    enddo
102    correc_bathy=-200.
103    do j=2,ny-1
104       do i=2,nx-1
105          if (BSOC(i,j).LT.correc_bathy) THEN
106             if (BSOC(i+1,j).eq.correc_bathy.or.BSOC(i,j+1).eq.correc_bathy.or.BSOC(i-1,j).eq.correc_bathy.or.bsoc(i,j-1).eq.correc_bathy.or.bsoc(i+1,j+1).eq.correc_bathy.or.bsoc(i-1,j-1).eq.correc_bathy) then
107                BSOC(i,j)=-500.
108             endif
109          endif
110       enddo
111    enddo
112    correc_bathy=-500.
113    do j=2,ny-1
114       do i=2,nx-1
115          if (BSOC(i,j).LT.correc_bathy) THEN
116             if (BSOC(i+1,j).eq.correc_bathy.or.BSOC(i,j+1).eq.correc_bathy.or.BSOC(i-1,j).eq.correc_bathy.or.bsoc(i,j-1).eq.correc_bathy.or.bsoc(i+1,j+1).eq.correc_bathy.or.bsoc(i-1,j-1).eq.correc_bathy) then
117                BSOC(i,j)=-750.
118             endif
119          endif
120       enddo
121    enddo
122    correc_bathy=-750.
123    do j=2,ny-1
124       do i=2,nx-1
125          if (BSOC(i,j).LT.correc_bathy) THEN
126             if (BSOC(i+1,j).eq.correc_bathy.or.BSOC(i,j+1).eq.correc_bathy.or.BSOC(i-1,j).eq.correc_bathy.or.bsoc(i,j-1).eq.correc_bathy.or.bsoc(i+1,j+1).eq.correc_bathy.or.bsoc(i-1,j-1).eq.correc_bathy) then
127                BSOC(i,j)=-1000.
128             endif
129          endif
130       enddo
131    enddo
132    correc_bathy=-1000.
133    do j=2,ny-1
134       do i=2,nx-1
135          if (BSOC(i,j).LT.correc_bathy) THEN
136             if (BSOC(i+1,j).eq.correc_bathy.or.BSOC(i,j+1).eq.correc_bathy.or.BSOC(i-1,j).eq.correc_bathy.or.bsoc(i,j-1).eq.correc_bathy.or.bsoc(i+1,j+1).eq.correc_bathy.or.bsoc(i-1,j-1).eq.correc_bathy) then
137                BSOC(i,j)=-1500.
138             endif
139          endif
140       enddo
141    enddo
142    correc_bathy=-1500.
143    do j=2,ny-1
144       do i=2,nx-1
145          if (BSOC(i,j).LT.correc_bathy) THEN
146             if (BSOC(i+1,j).eq.correc_bathy.or.BSOC(i,j+1).eq.correc_bathy.or.BSOC(i-1,j).eq.correc_bathy.or.bsoc(i,j-1).eq.correc_bathy.or.bsoc(i+1,j+1).eq.correc_bathy.or.bsoc(i-1,j-1).eq.correc_bathy) then
147                BSOC(i,j)=-2000.
148             endif
149          endif
150       enddo
151    enddo
152    correc_bathy=-2000.
153    do j=2,ny-1
154       do i=2,nx-1
155          if (BSOC(i,j).LT.correc_bathy) THEN
156             if (BSOC(i+1,j).eq.correc_bathy.or.BSOC(i,j+1).eq.correc_bathy.or.BSOC(i-1,j).eq.correc_bathy.or.bsoc(i,j-1).eq.correc_bathy.or.bsoc(i+1,j+1).eq.correc_bathy.or.bsoc(i-1,j-1).eq.correc_bathy) then
157                BSOC(i,j)=-3000.
158             endif
159          endif
160       enddo
161    enddo
162    correc_bathy=-3000.
163    do j=2,ny-1
164       do i=2,nx-1
165          if (BSOC(i,j).LT.correc_bathy) THEN
166             if (BSOC(i+1,j).eq.correc_bathy.or.BSOC(i,j+1).eq.correc_bathy.or.BSOC(i-1,j).eq.correc_bathy.or.bsoc(i,j-1).eq.correc_bathy.or.bsoc(i+1,j+1).eq.correc_bathy.or.bsoc(i-1,j-1).eq.correc_bathy) then
167                BSOC(i,j)=-4000.
168             endif
169          endif
170       enddo
171    enddo
172
173
174
175! pour ne pas avoir de bathymetrie aberante :
176    where (BSOC(:,:).LT.-5000) BSOC(:,:)=-5000.
177! bathymetrie de reference :
178 BSOC0(:,:)=BSOC(:,:)
179
180    ! lecture des coordonnées geographiques
181    ! les coordonnees sont calculees en °dec avec GMT,
182    ! les longitudes sont comprises entre 0 et 360
183    open(unit=2004,file=trim(dirnameinp)//trim(grid_topo),iostat=ios)
184    do k=1,nx*ny
185       read(2004,*) i,j,XCC(i,j),YCC(i,j),XLONG(i,j),YLAT(i,j)
186    enddo
187    close(2004)
188    write(42,*) 'fichier grille: ', filin
189
190    ! passage en longitude -180 +180 :
191    where (XLONG(:,:).GT.180) XLONG(:,:)=XLONG(:,:)-360.
192       xmin=xcc(1,1)
193       ymin=ycc(1,1)
194       xmax=xcc(nx,ny)
195       ymax=ycc(nx,ny)
196
197
198       ! flux geothermique fixe :
199       ghf(:,:)=-SECYEAR/1000.*42.
200       ! pour passer les flux des mW/m2 au J/m2/an     
201       !      ghf(:,:)=-SECYEAR/1000.*ghf(:,:)
202       !     write(42,*) 'flux geothermique fixe : 55 mW/m2'
203       !     ghf(:,:)=-SECYEAR/1000.*55. !B6norcg2
204
205!       print*,'lect topo'
206!       print*,'shb0',S0(300,150),H0(300,150),BSOC0(300,150)
207       !    Initialisation du Masque
208       !------------------------------------------------
209       ! pour l'Hemisphere Nord mko vrai partout (version 2006)
210       MK0(:,:)=1
211
212       !------------------------------------------------     
213     end subroutine input_topo
214
215   end module lect_topo_snowball
Note: See TracBrowser for help on using the repository browser.