source: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/nxgraro2_loc.f90 @ 5409

Last change on this file since 5409 was 5159, checked in by abarral, 5 months ago

Put dimensions.h and paramet.h into modules

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 3.4 KB
Line 
1 SUBROUTINE nxgraro2_loc(klevel,xcov,ycov,lr,grx_out,gry_out)
2
3  !  P.Le Van .
4  !   ***********************************************************
5  !                             lr
6  !  calcul de  ( nxgrad (rot) )   du vect. v  ....
7
8  !   xcov et ycov  etant les compos. covariantes de  v
9  !   ***********************************************************
10  ! xcov , ycov et lr  sont des arguments  d'entree pour le s-prog
11  !  grx   et  gry     sont des arguments de sortie pour le s-prog
12
13
14  USE write_Field_p
15  USE parallel_lmdz
16  USE times
17  USE mod_hallo
18  USE lmdz_filtreg_p
19  USE nxgraro2_mod
20  USE lmdz_comdissipn, ONLY: tetaudiv, tetaurot, tetah, cdivu, crot, cdivh
21
22USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
23  USE lmdz_paramet
24  IMPLICIT NONE
25  !
26
27
28
29  !    ......  variables en arguments  .......
30
31  INTEGER :: klevel
32  REAL :: xcov( ijb_u:ije_u,klevel ), ycov( ijb_v:ije_v,klevel )
33  REAL :: grx_out( ijb_u:ije_u,klevel ),gry_out(ijb_v:ije_v,klevel)
34
35  !    ......   variables locales     ........
36
37  REAL :: signe, nugradrs
38  INTEGER :: l,ij,iter,lr
39  Type(Request),SAVE :: Request_dissip
40!$OMP THREADPRIVATE(Request_dissip)
41  !    ........................................................
42
43  INTEGER :: ijb,ije,jjb,jje
44
45
46
47  signe    = (-1.)**lr
48  nugradrs = signe * crot
49
50  !  CALL SCOPY ( ip1jmp1* klevel, xcov, 1, grx, 1 )
51  !  CALL SCOPY (  ip1jm * klevel, ycov, 1, gry, 1 )
52
53  ijb=ij_begin
54  ije=ij_end
55
56!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
57  DO    l = 1, klevel
58    grx(ijb:ije,l)=xcov(ijb:ije,l)
59  ENDDO
60!$OMP END DO NOWAIT
61
62!$OMP BARRIER
63   CALL Register_Hallo_u(grx,llm,0,1,1,0,Request_dissip)
64   CALL SendRequest(Request_dissip)
65!$OMP BARRIER
66   CALL WaitRequest(Request_dissip)
67!$OMP BARRIER
68
69  ijb=ij_begin
70  ije=ij_end
71  IF(pole_sud) ije=ij_end-iip1
72
73!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
74  DO    l = 1, klevel
75    gry(ijb:ije,l)=ycov(ijb:ije,l)
76  ENDDO
77!$OMP END DO NOWAIT
78
79
80  CALL     rotatf_loc ( klevel, grx, gry, rot )
81   ! CALL write_field3d_p('rot1',reshape(rot,(/iip1,jjm,llm/)))
82
83!$OMP BARRIER
84   CALL Register_Hallo_v(rot,llm,1,1,1,1,Request_dissip)
85   CALL SendRequest(Request_dissip)
86!$OMP BARRIER
87   CALL WaitRequest(Request_dissip)
88!$OMP BARRIER
89
90  CALL laplacien_rot_loc ( klevel, rot, rot,grx,gry      )
91    ! CALL write_field3d_p('rot2',reshape(rot,(/iip1,jjm,llm/)))
92
93  !    .....   Iteration de l'operateur laplacien_rotgam  .....
94
95  DO  iter = 1, lr -2
96!$OMP BARRIER
97   CALL Register_Hallo_v(rot,llm,1,1,1,1,Request_dissip)
98   CALL SendRequest(Request_dissip)
99!$OMP BARRIER
100   CALL WaitRequest(Request_dissip)
101!$OMP BARRIER
102
103    CALL laplacien_rotgam_loc( klevel, rot, rot )
104  ENDDO
105
106    ! CALL write_field3d_p('rot3',reshape(rot,(/iip1,jjm,llm/)))
107
108
109
110  jjb=jj_begin
111  jje=jj_end
112  IF (pole_sud) jje=jj_end-1
113
114  CALL filtreg_p( rot, jjb_v,jje_v, jjb,jje,jjm, &
115        klevel, 2,1, .FALSE.,1)
116!$OMP BARRIER
117   CALL Register_Hallo_v(rot,llm,1,0,0,1,Request_dissip)
118   CALL SendRequest(Request_dissip)
119!$OMP BARRIER
120   CALL WaitRequest(Request_dissip)
121!$OMP BARRIER
122
123  CALL nxgrad_loc ( klevel, rot, grx, gry )
124
125
126  ijb=ij_begin
127  ije=ij_end
128
129!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
130  DO    l = 1, klevel
131
132     IF(pole_sud) ije=ij_end-iip1
133     DO  ij = ijb, ije
134      gry_out( ij,l ) = gry( ij,l ) * nugradrs
135     ENDDO
136
137     IF(pole_sud) ije=ij_end
138     DO  ij = ijb, ije
139      grx_out( ij,l ) = grx( ij,l ) * nugradrs
140     ENDDO
141
142  ENDDO
143!$OMP END DO NOWAIT
144  !
145
146END SUBROUTINE nxgraro2_loc
Note: See TracBrowser for help on using the repository browser.