source: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dteta1_loc.f90 @ 5295

Last change on this file since 5295 was 5159, checked in by abarral, 3 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: 2.1 KB
RevLine 
[5106]1SUBROUTINE dteta1_loc( teta, pbaru, pbarv, dteta)
[5105]2  USE parallel_lmdz
3  USE write_field_p
[5106]4  USE lmdz_filtreg_p
[5159]5  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
6  USE lmdz_paramet
[5105]7  IMPLICIT NONE
[1632]8
[5105]9  !=======================================================================
[5159]10
[5105]11  !   Auteur:  P. Le Van
12  !   -------
13  ! Modif F.Forget 03/94 (on retire q et dq  pour construire dteta1)
[5159]14
[5105]15  !   ********************************************************************
16  !   ... calcul du terme de convergence horizontale du flux d'enthalpie
17  !    potentielle   ......
18  !   ********************************************************************
19  !  .. teta,pbaru et pbarv sont des arguments d'entree  pour le s-pg ....
[5158]20  ! dteta               sont des arguments de sortie pour le s-pg ....
[5159]21
[5105]22  !=======================================================================
[1632]23
24
25
[5159]26
27
[5105]28  REAL :: teta( ijb_u:ije_u,llm )
29  REAL :: pbaru( ijb_u:ije_u,llm ),pbarv( ijb_v:ije_v,llm)
30  REAL :: dteta( ijb_u:ije_u,llm )
31  INTEGER :: l,ij
[1632]32
[5105]33  REAL :: hbyv( ijb_v:ije_v,llm ), hbxu( ijb_u:ije_u,llm )
[1632]34
[5159]35
[5105]36  INTEGER :: ijb,ije,jjb,jje
[1632]37
38
[5105]39  jjb=jj_begin
40  jje=jj_end
[1632]41
[5105]42!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
43  DO l = 1,llm
[1632]44
[5105]45  ijb=ij_begin
46  ije=ij_end
[1632]47
[5117]48  IF (pole_nord) ijb=ij_begin+iip1
49  IF (pole_sud)  ije=ij_end-iip1
[1632]50
[5105]51  DO ij = ijb, ije - 1
52    hbxu(ij,l) = pbaru(ij,l) * 0.5 * ( teta(ij,l)+teta(ij+1,l) )
53  END DO
[1632]54
[5105]55  !    .... correction pour  hbxu(iip1,j,l)  .....
56  !    ....   hbxu(iip1,j,l)= hbxu(1,j,l) ....
[1632]57
[5105]58  !DIR$ IVDEP
59  DO ij = ijb+iip1-1, ije, iip1
60    hbxu( ij, l ) = hbxu( ij - iim, l )
61  END DO
62
63  ijb=ij_begin-iip1
[5117]64  IF (pole_nord) ijb=ij_begin
[5105]65
66  DO ij = ijb,ije
67    hbyv(ij,l)= pbarv(ij, l)* 0.5 * ( teta(ij, l)+teta(ij+iip1,l) )
68  END DO
69
[5117]70   IF (.NOT. pole_sud) THEN
[5105]71      hbxu(ije+1:ije+iip1,l) = 0
72      hbyv(ije+1:ije+iip1,l) = 0
73    endif
74
75  END DO
76!$OMP END DO NOWAIT
77
78
79    CALL  convflu_loc ( hbxu, hbyv, llm, dteta )
80
81
82  !    stockage dans  dh de la convergence horizont. filtree' du  flux
83               ! ....                           ...........
84        ! d'enthalpie potentielle .
85
86
87  CALL filtreg_p( dteta,jjb_u,jje_u,jjb,jje,jjp1, llm, &
88        2, 2, .TRUE., 1)
89
90
91
92END SUBROUTINE dteta1_loc
Note: See TracBrowser for help on using the repository browser.