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