source: branches/iLoveclim/SOURCES/Ant40_files/lect-anteis_mod.f90 @ 35

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

Merge avec la r34 du trunk

File size: 7.9 KB
Line 
1!> \file lect-anteis_mod.f90
2!!Module pour la lecture de la topographie
3!<
4
5!> \namespace lect_topo_anteis
6!! Module pour la lecture de la topographie
7!! \author ...
8!! \date ...
9!! @note Used module
10!! @note   - use module3D_phy
11!! @note   - use param_phy_mod
12!<
13module lect_topo_anteis
14
15  use module3D_phy
16  use interface_input
17  use io_netcdf_grisli
18
19  implicit none
20
21  character(len=100) :: topo_dep       ! Topo de départ
22  character(len=100) :: topo_ref       ! Topo de référence
23  character(len=100) :: grid_topo      ! fichier grille
24  character(len=100) :: ghf_fich       ! fichier grille
25  character(len=100) :: filin
26  character(len=100) :: file_ncdf      !< fichier netcdf issue des fichiers .dat
27
28!  character(len=100) :: file1
29!  character(len=100) :: file2
30
31  real, dimension(nx,ny,5) :: bidon          ! pour l'appel a courbure
32  real :: sealevel0
33
34contains
35 
36  subroutine input_topo
37
38    integer :: ios
39
40    namelist/topo_file/topo_ref,topo_dep,grid_topo,ghf_fich
41    rewind(num_param)        ! pour revenir au debut du fichier param_list.dat
42    read(num_param,topo_file)
43    ! formats pour les ecritures dans 42
44428 format(A)
45    write(num_rep_42,428)'!___________________________________________________________' 
46    write(num_rep_42,428) '&topo_file                                  !  input_topo  '
47    write(num_rep_42,'(A,A)') 'topo_ref = ', topo_ref
48    write(num_rep_42,'(A,A)') 'topo_dep = ', topo_dep
49    write(num_rep_42,'(A,A)') 'grid_topo =', grid_topo
50    write(num_rep_42,'(A,A)') 'ghf_fich = ', ghf_fich
51    write(num_rep_42,*)'/'                     
52    write(num_rep_42,428) '! topo_ref= topo ref isostasie'
53    write(num_rep_42,428) '! topo_dep= topo de depart'
54    write(num_rep_42,428) '! grid_topo : fichier i,j,x,y,lon,lat'
55    write(num_rep_42,428) '! ghf_fich  : fichier flux geothermique' 
56    write(num_rep_42,*)
57
58    topo_ref=trim(dirnameinp)//trim(topo_ref) 
59    topo_dep=trim(dirnameinp)//trim(topo_dep) 
60    grid_topo=trim(dirnameinp)//trim(grid_topo)
61    ghf_fich=trim(dirnameinp)//trim(ghf_fich)
62
63
64    ! lecture adaptee aux fichiers intercomparaison EISMINT
65    nxx=nx
66    nyy=ny
67
68!!$!     lecture de la topo actuelle
69!!$!     ---------------------------
70!!$     open (20,file=TRIM(DIRNAMEINP)//file2,status='old')
71!!$       
72!!$     read(20,'(A80)') TITRE
73!!$     read(20,*) NI,NJ,NXX,NYY,STEP
74!!$     read(20,*)
75!!$         do J=1,ny
76!!$          do I=1,nx
77!!$             read (20,*)  S0(I,J),H0(I,J),BSOC0(I,J)
78!!$             S0(i,j)=max(S0(i,j),0.)
79!!$          end do
80!!$        end do
81!!$     close(20)
82!!$
83!!$     
84!!$!     lecture de la topo de depart
85!!$!     ---------------------------
86!!$     open (20,file=TRIM(DIRNAMEINP)//file1,status='old')
87!!$!         open (20,file='../INPUT-DATA/hemin.g50')
88!!$     read(20,'(A80)') TITRE
89!!$     read(20,*) NI,NJ,NXX,NYY,STEP
90!!$     read(20,*)
91!!$         do J=1,ny
92!!$          do I=1,nx
93!!$             read (20,*) S(I,J),H(I,J),BSOC(I,J)
94!!$          end do
95!!$        end do
96!!$     close(20)
97
98    !     lecture de la topo de référence
99    !     -------------------------------
100    ! Cette topo sert a calculer le socle de reference pour l'isostasie
101    ! voir init_iso et a avoir une surface de reference pour les temperatures
102    ! lecture adaptee aux fichiers ZBL.dat ou netcdf ou grd
103    call lect_input(1,'Bsoc',1,Bsoc0,topo_ref,file_ncdf)    ! socle
104    call lect_input(1,'S',1,S0,topo_ref,file_ncdf)          ! surface
105    call lect_input(1,'H',1,H0,topo_ref,file_ncdf)          ! epaisseur
106!cdc correction point pole sud :
107!    S0(71,71)=(S0(71,70)+S0(71,72)+S0(70,71)+S0(72,71))/4.
108!    Bsoc0(71,71)=(Bsoc0(71,70)+Bsoc0(71,72)+Bsoc0(70,71)+Bsoc0(72,71))/4.
109
110
111!    where (S0(:,:).GT.0)
112!       H0(:,:)=S0(:,:)-BSOC0(:,:)
113!    elsewhere
114!       H0(:,:)=1.
115!    endwhere
116
117
118    where (BSOC(:,:).LT.-9999.)
119       BSOC(:,:)=-9999.
120    endwhere
121
122    sealevel0=0.  ! voir a passer dans le fichier parametre
123    S0(:,:)=max(S0(:,:),sealevel0)   ! pour etre au niveau des mers : ATTENTION si SEALEV <0
124    mk0(:,:) = 1                   ! mk0=0 pour les zones interdites
125
126    !     lecture de la topo de depart
127    !     ---------------------------
128    ! lecture adaptee aux fichiers ZBL.dat ou netcdf ou grd
129    call lect_input(1,'Bsoc',1,Bsoc,topo_dep,file_ncdf)    ! socle
130    call lect_input(1,'S',1,S,topo_dep,file_ncdf)          ! surface
131    call lect_input(1,'H',1,H,topo_dep,file_ncdf)          ! epaisseur
132!    S(71,71)=(S(71,70)+S(71,72)+S(70,71)+S(72,71))/4.
133!    Bsoc(71,71)=(Bsoc(71,70)+Bsoc(71,72)+Bsoc(70,71)+Bsoc(72,71))/4.
134!    where (S(:,:).GT.0)
135!       H(:,:)=S(:,:)-BSOC(:,:)
136!    elsewhere
137!       H(:,:)=1.
138!    endwhere
139    S(:,:)=max(S(:,:),0.)   ! pour etre au niveau des mers : ATTENTION si SEALEV <0
140    H(:,:)=max(H(:,:),1.)   ! pour avoir au moins 1 m
141
142
143
144!!$
145!!$    ! socle
146!!$    filin='bedelev-2000-40km.dat'
147!!$    call lect_eis(nx,ny,BSOC,filin,DIRNAMEINP)
148!!$    write(num_rep_42,*) 'fichier BSOC (socle) : ', filin
149!!$    Bsoc0(:,:)=Bsoc(:,:)
150!!$    !  surface
151!!$    filin='surface-2000-40km.dat'
152!!$    call lect_eis(nx,ny,S,filin,DIRNAMEINP)
153!!$    write(num_rep_42,*) 'fichier surface : ', filin
154!!$
155!!$    !     epaisseur
156!!$    filin='icethic-2000-40km.dat'
157!!$    call lect_eis(nx,ny,H,filin,DIRNAMEINP)
158!!$    write(num_rep_42,*) 'fichier epaisseur : ', filin
159!!$    H0(:,:)=H(:,:)
160!!$
161!!$
162!!$    !     masque
163!!$    filin='maskHUY40km.dat'
164!!$    call lect_ieis(nx,ny,MK0,filin,DIRNAMEINP)
165!!$    write(num_rep_42,*) 'fichier masque : ', filin
166!!$
167!!$    !     enlever les epaisseurs fictives de Philippe
168!!$    do I=1,NX
169!!$       do J=1,NY
170!!$          !     attention les valeurs de masque de Philippe sont differentes
171!!$          if ((MK0(I,J).gt.1).and.(H(i,j).le.218.00)) then ! mer libre
172!!$             H(i,j)=1.
173!!$             S(I,J)=H(i,j)-(RO/ROW)*H(i,j)
174!!$          endif
175!!$       end do
176!!$    end do
177
178
179!    S0(:,:)=S(:,:)
180
181    ! pour l'Antarctique masque mko vrai partout (version 2006)
182    MK0(:,:)=1
183
184    ! determination des flot
185    do J=1,NY
186       do I=1,NX
187          if ((BSOC(I,J)+H(I,J)*RO/ROW -SEALEVEL).LT.0.) then
188             FLOT(I,J)=.TRUE.
189          else
190             FLOT(I,J)=.FALSE.
191          endif
192       enddo
193    enddo
194
195
196! calcul des courbures du socle
197
198     call courbure(nx,ny,dx,Bsoc,bidon(:,:,1),bidon(:,:,2),bidon(:,:,3), &
199          bidon(:,:,4),socle_cry,bidon(:,:,5))
200     socle_cry(:,:)=socle_cry(:,:)*dx*dx
201
202    ! lecture des coordonnées geographiques
203!    filin=TRIM(DIRNAMEINP)//'coord-Ant-40km.dat'
204
205    ! les coordonnees sont calculees en °dec avec GMT,
206    ! les longitudes sont comprises entre -180 et +180 (negative a l'Ouest de
207    ! Greenwich et positive a l'Est)
208    open(unit=2004,file=grid_topo,iostat=ios)
209    do k=1,nx*ny
210       read(2004,*) i,j,xcc(i,j),ycc(i,j),Xlong(i,j),Ylat(i,j)
211    enddo
212    close(2004)
213
214    xmin=xcc(1,1)/1000.
215    ymin=ycc(1,1)/1000.
216    xmax=xcc(nx,ny)/1000.
217    ymax=ycc(nx,ny)/1000.
218
219!!$    !     lecture du fichier de reference pour le calcul du niveau des mers : etat actuel
220!!$    open(88,file=TRIM(DIRNAMEINP)//'grzone56-k000.pl')
221!!$
222!!$    read(88,*)
223!!$    read(88,*)
224!!$    read(88,*)
225!!$    do j=1,ny
226!!$       do i=1,nx
227!!$          read(88,*) S_sealev(i,j),H_sealev(i,j),B_sealev(i,j),M_sealev(i,j)
228!!$       enddo
229!!$    enddo
230!!$    close(88)
231!!$
232!!$    write(num_rep_42,*) 'fichier reference pour le niveau des mers : ', &
233!!$         TRIM(DIRNAMEINP)//'grzone56-k000.pl'
234
235    ! lecture du flux geothermique de Shapiro
236    open(88,file=ghf_fich)
237
238!    write(num_rep_42,*) 'flux geothermique Shapiro : ', TRIM(DIRNAMEINP)//'ijphi-40km-ant.dat'
239!    do k=1,nx*ny
240!       read(88,*) i,j,ghf(i,j)
241!    end do
242!    close(88)
243
244    call lect_input(1,'ghf',1,ghf,ghf_fich,file_ncdf)    ! socle
245
246
247
248    ! pour passer les flux des mW/m2 au J/m2/an     
249    ghf(:,:)=-SECYEAR/1000.*ghf(:,:)
250
251!------------------------------------------------
252! mko vrai partout (version 2006)
253    MK0(:,:)=1
254
255!------------------------------------------------
256
257
258  end subroutine input_topo
259
260
261end module lect_topo_anteis
Note: See TracBrowser for help on using the repository browser.