source: LMDZ6/trunk/libf/dyn3dmem/divgrad2_loc.f90 @ 5408

Last change on this file since 5408 was 5285, checked in by abarral, 7 weeks ago

As discussed internally, remove generic ONLY: ... for new _mod_h 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: 2.9 KB
RevLine 
[5246]1SUBROUTINE divgrad2_loc ( klevel, h, deltapres, lh, divgra_out )
2  !
3  ! P. Le Van
4  !
5  !   ***************************************************************
6  !
7  ! .....   calcul de  (div( grad ))   de (  pext * h ) .....
8  !   ****************************************************************
9  !   h ,klevel,lh et pext  sont des arguments  d'entree pour le s-prg
10  !     divgra     est  un argument  de sortie pour le s-prg
11  !
[5281]12  USE comgeom2_mod_h
[5280]13  USE comdissipn_mod_h
[5246]14  USE parallel_lmdz
15  USE times
16  USE mod_hallo
17  USE divgrad2_mod
[5271]18  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
[5285]19USE paramet_mod_h
[5271]20IMPLICIT NONE
[5246]21  !
[5271]22
[5272]23
[1632]24
[5246]25  !    .......    variables en arguments   .......
26  !
27  INTEGER :: klevel
28  REAL :: h( ijb_u:ije_u,klevel ), deltapres( ijb_u:ije_u,klevel )
29  REAL :: divgra_out( ijb_u:ije_u,klevel)
30  !    .......    variables  locales    ..........
31  !
32  REAL :: signe, nudivgrs, sqrtps( ijb_u:ije_u,llm )
33  INTEGER :: l,ij,iter,lh
34  !    ...................................................................
35  Type(Request),SAVE :: request_dissip
[1848]36!$OMP THREADPRIVATE(request_dissip)
[5246]37  INTEGER :: ijb,ije
[1632]38
[5246]39  !
40  !
41  signe    = (-1.)**lh
42  nudivgrs = signe * cdivh
[1632]43
[5246]44   ! CALL SCOPY ( ip1jmp1 * klevel, h, 1, divgra, 1 )
45  ijb=ij_begin
46  ije=ij_end
47!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
48  DO l = 1, klevel
49    divgra(ijb:ije,l)=h(ijb:ije,l)
50  ENDDO
51!$OMP END DO NOWAIT
52  !
53!$OMP BARRIER
54   call Register_Hallo_u(divgra,llm,1,1,1,1,Request_dissip)
55   call SendRequest(Request_dissip)
56!$OMP BARRIER
57   call WaitRequest(Request_dissip)
58!$OMP BARRIER
[1632]59
[5246]60  CALL laplacien_loc( klevel, divgra, divgra )
[1632]61
[5246]62!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
63  DO l = 1, klevel
64   DO ij = ijb, ije
65    sqrtps( ij,l ) = SQRT( deltapres(ij,l) )
66   ENDDO
67  ENDDO
68!$OMP END DO NOWAIT
[1632]69
[5246]70  !
71!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
72  DO l = 1, klevel
73    DO ij = ijb, ije
74     divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)
75    ENDDO
76  ENDDO
77!$OMP END DO NOWAIT
[1632]78
[5246]79  !    ........    Iteration de l'operateur  laplacien_gam    ........
80  !
81  DO  iter = 1, lh - 2
82!$OMP BARRIER
83   call Register_Hallo_u(divgra,llm,1,1,1,1,Request_dissip)
84   call SendRequest(Request_dissip)
85!$OMP BARRIER
86   call WaitRequest(Request_dissip)
[1632]87
[5246]88!$OMP BARRIER
[1632]89
90
[5246]91   CALL laplacien_gam_loc(klevel,cuvscvgam2,cvuscugam2,unsair_gam2, &
92         unsapolnga2, unsapolsga2,  divgra, divgra )
93  ENDDO
94  !
95  !    ...............................................................
[1632]96
[5246]97!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
98  DO l = 1, klevel
99    DO ij = ijb, ije
100      divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)
101    ENDDO
102  ENDDO
103!$OMP END DO NOWAIT
104  !
105!$OMP BARRIER
106   call Register_Hallo_u(divgra,llm,1,1,1,1,Request_dissip)
107   call SendRequest(Request_dissip)
108!$OMP BARRIER
109   call WaitRequest(Request_dissip)
110!$OMP BARRIER
[1632]111
[5246]112  CALL laplacien_loc ( klevel, divgra, divgra )
113  !
114!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
115  DO l  = 1,klevel
116  DO ij = ijb,ije
117  divgra_out(ij,l) =  nudivgrs * divgra(ij,l) / deltapres(ij,l)
118  ENDDO
119  ENDDO
120!$OMP END DO NOWAIT
121
122  RETURN
123END SUBROUTINE divgrad2_loc
Note: See TracBrowser for help on using the repository browser.