source: LMDZ6/trunk/libf/phylmd/Dust/read_vent.f90 @ 5367

Last change on this file since 5367 was 5337, checked in by Laurent Fairhead, 4 weeks ago

Getting rid of dependance to dynamics

File size: 3.4 KB
Line 
1SUBROUTINE read_vent(debutphy, step, nbjour, u10m_ec, v10m_ec)
2  USE dimphy
3  USE mod_grid_phy_lmdz
4  USE mod_phys_lmdz_para
5  USE netcdf, ONLY: nf90_get_var, nf90_open, nf90_inq_varid, nf90_nowrite
6   ! USE write_field_phy
7!!USE paramet_mod_h
8IMPLICIT NONE
9
10    ! INCLUDE "dimphy.h"
11
12  !
13  INTEGER :: step, nbjour
14  LOGICAL :: debutphy
15  real :: u10m_ec(klon), v10m_ec(klon)
16  real :: u10m_ec_glo(klon_glo), v10m_ec_glo(klon_glo)
17  !
18  !  real u10m_nc(iip1,jjp1) !, v10m_nc(iip1,jjm) ! dim 97x72
19  !  real v10m_nc(iip1,jjp1)  ! dim 97x73
20  real :: u10m_nc_glo(nbp_lon+1,nbp_lat) !, v10m_nc(iip1,jjm) ! dim 97x72
21  real :: v10m_nc_glo(nbp_lon+1,nbp_lat)  ! dim 97x73
22  integer :: ncidu1, varidu1, ncidv1, varidv1, rcode
23  save ncidu1, varidu1, ncidv1, varidv1
24!$OMP THREADPRIVATE(ncidu1, varidu1, ncidv1, varidv1)
25  integer :: start(4),count(4), status
26  integer :: i, j, ig
27
28
29  !
30!$OMP MASTER
31  IF (is_mpi_root .AND. is_omp_root) THEN
32  if (debutphy) then
33  !
34     ncidu1=nf90_open('u10m.nc',nf90_nowrite,rcode)
35     varidu1=nf90_inq_varid(ncidu1,'U10M',rcode)
36     ncidv1=nf90_open('v10m.nc',nf90_nowrite,rcode)
37     varidv1=nf90_inq_varid(ncidv1,'V10M',rcode)
38  !
39  endif
40  !
41  start(1)=1
42  start(2)=1
43  start(4)=0
44
45   ! count(1)=iip1
46  count(1)=nbp_lon+1
47   ! count(2)=jjp1
48  count(2)=nbp_lat
49  count(3)=1
50  count(4)=0
51  !
52  start(3)=step
53  !
54  status = nf90_get_var(ncidu1, varidu1, u10m_nc_glo, start, count)
55
56    ! print *,status
57  !
58  status = nf90_get_var(ncidv1, varidv1, v10m_nc_glo, start, count)
59
60  !
61
62  !  print *,'beforebidcor u10m_nc', u10m_nc(1,jjp1)
63  !  print *,'beforebidcor v10m_nc', v10m_nc(1,jjp1)
64
65  !   print *,status
66  !  call correctbid(iim,jjp1,u10m_nc)
67  !  call correctbid(iim,jjp1,v10m_nc)
68  call correctbid(nbp_lon,nbp_lat,u10m_nc_glo)
69  call correctbid(nbp_lon,nbp_lat,v10m_nc_glo)
70
71   ! print *,'afterbidcor u10m_nc', u10m_nc(1,jjp1)
72   ! print *,'afterbidcor v10m_nc', v10m_nc(1,jjp1)
73  !
74  !--upside down + physical grid
75  !
76  !  u10m_ec(1)=u10m_nc(1,jjp1)
77  !  v10m_ec(1)=v10m_nc(1,jjp1)
78  u10m_ec_glo(1)=u10m_nc_glo(1,nbp_lat)
79  v10m_ec_glo(1)=v10m_nc_glo(1,nbp_lat)
80  ig=2
81   ! DO j=2,jjm
82   !    DO i = 1, iim
83  DO j=2,nbp_lat-1
84     DO i = 1, nbp_lon
85        ! u10m_ec(ig)=u10m_nc(i,jjp1+1-j)
86        ! v10m_ec(ig)=v10m_nc(i,jjp1+1-j)
87       u10m_ec_glo(ig)=u10m_nc_glo(i,nbp_lat+1-j)
88       v10m_ec_glo(ig)=v10m_nc_glo(i,nbp_lat+1-j)
89       ig=ig+1
90      ! print *,u10m_ec(ig) ,v10m_ec(ig)
91     ENDDO
92  ENDDO
93  u10m_ec_glo(ig)=u10m_nc_glo(1,1)
94  v10m_ec_glo(ig)=v10m_nc_glo(1,1)
95
96
97   ! end if master
98  ENDIF
99!$OMP END MASTER
100!$OMP BARRIER
101  CALL scatter(u10m_ec_glo,u10m_ec)
102  CALL scatter(v10m_ec_glo,v10m_ec)
103
104   ! print *,'JE  tamagno viento ig= ', ig
105   ! print *,'READ_VENT U = ',SUM(u10m_ec),MINVAL(u10m_ec),
106  ! .                                      MAXVAL(u10m_ec)
107  !  print *,'READ_VENT V = ',SUM(v10m_ec),MINVAL(v10m_ec),
108  ! .                                      MAXVAL(v10m_ec)
109  !   print *,'u v 1 ', u10m_ec(1),v10m_ec(1)
110  !   print *,'u v klon ', u10m_ec(klon),v10m_ec(klon)
111  RETURN
112END SUBROUTINE read_vent
113
114! added by JE from the nh SPLA, dyn3d/read_reanalyse.F which is not available any more
115subroutine correctbid(iim,nl,x)
116  integer :: iim,nl
117  real :: x(iim+1,nl)
118  integer :: i,l
119  real :: zz
120
121  do l=1,nl
122     do i=2,iim-1
123        if(abs(x(i,l)).gt.1.e10) then
124           zz=0.5*(x(i-1,l)+x(i+1,l))
125           ! print*,'correction ',i,l,x(i,l),zz
126           x(i,l)=zz
127        endif
128     enddo
129  enddo
130
131  return
132end subroutine correctbid
133
134
135
Note: See TracBrowser for help on using the repository browser.