source: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_vent.f90 @ 5105

Last change on this file since 5105 was 5105, checked in by abarral, 8 weeks ago

Replace 1DUTILS.h by module lmdz_1dutils.f90
Replace 1DConv.h by module lmdz_old_1dconv.f90 (it's only used by old_* files)
Convert *.F to *.f90
Fix gradsdef.h formatting
Remove unnecessary "RETURN" at the end of functions/subroutines

File size: 3.5 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  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
105END SUBROUTINE read_vent
106
107! added by JE from the nh SPLA, dyn3d/read_reanalyse.F which is not available any more
108SUBROUTINE 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
125END SUBROUTINE  correctbid
126
127
128
Note: See TracBrowser for help on using the repository browser.