source: trunk/LMDZ.COMMON/libf/dyn3dpar/pres2lev_mod.F90 @ 1243

Last change on this file since 1243 was 979, checked in by emillour, 12 years ago

Common dynamics:
Updates in the dynamics (seq and ) to keep up with updates
in LMDZ5 (up to LMDZ5 trunk, rev 1760):

  • General stuff (essentially to keep up with Earth model):
  • Updated makelmdz_fcm and makelmdz (more control on dimension.h, added option -mem, although it is not usefull for now)
  • Updated build_gcm with more control over fcm
  • Updated create_make_gcm (enable looking for code in subdirectories)
  • bibio:
  • updates (just renaming the files actually...) new_unit.F90 => new_unit_m.F90, pchsp_95.F90 => pchsp_95_m.F90 and pchfe_95.F90 => pchfe_95_m.F90
  • filtrez:
  • mod_fft.F90: use more baseline CPP directives for preprocessor compatibility
  • mod_filtre_fft_loc.F90: added this new file
  • filtreg_mod.f90: added calls to init_..._loc
  • filtreg.F: fixed calls to DGEMM into SGEMM (preprocessing does the switch)
  • dyn3d:
  • removed obsolete files: etat0_netcdf.F90 limit_netcdf.F90

pres2lev.F90

  • added new file : pres2lev_mod.F90 (module containing "old" pres2lev)
  • gcm.F: changed args to call to inidissip (added arg "vert_prof_dissip")
  • inidissip.F90: added arg "vert_prof_dissip" and the "earth model" discterizations (flagged with "planet_type=="earth")
  • comdissnew.h: added 'vert_prof_dissip' to the common block
  • guide_mod.F90: added the "use pres2lev_mod"
  • conf_gcm.F: cosmetics, and evaluation of vert_prof_dissip, (and also of dissip_* factors, for Earth model)
  • comconst.h : added dissip_factz,dissip_zref variables (for Earth mode dissip)
  • dyn3dpar:
  • removed obsolete files: etat0_netcdf.F90 limit_netcdf.F90

pres2lev.F90 mod_const_para.F90

  • added new files: pres2lev_mod.F90 (module containing "old" pres2lev)

mod_const_mpi

  • abort_gcm : better control of abort in parallel mode
  • gcm.F: changed args to call to inidissip (added arg "vert_prof_dissip")
  • inidissip.F90: added arg "vert_prof_dissip" and the "earth model" discterizations (flagged with "planet_type=="earth")
  • comdissnew.h: added 'vert_prof_dissip' to the common block
  • filtreg_p.F : bug correction (array bounds)
  • guide_p_mod.F90 : added the "use pres2lev_mod"
  • conf_gcm.F : cosmetics (and evaluation of vert_prof_dissip , and

also of dissip_* factors, for Earth model)
plus check if "adjust" is indeed not used in OpenMP

  • comconst.h : add dissip_factz,dissip_zref variables (for Earth mode dissip)

EM
File size: 2.0 KB
Line 
1! $Id: pres2lev.F 1179 2009-06-11 14:18:47Z jghattas $
2!
3MODULE pres2lev_mod
4
5CONTAINS
6
7!******************************************************
8SUBROUTINE pres2lev(varo,varn,lmo,lmn,po,pn,ni,nj,ok_invertp)
9!
10! interpolation lineaire pour passer
11! a une nouvelle discretisation verticale pour
12! les variables de GCM
13! Francois Forget (01/1995)
14! MOdif remy roca 12/97 pour passer de pres2sig
15! Modif F.Codron 07/08 po en 3D
16!**********************************************************
17
18  IMPLICIT NONE
19
20!   Declarations:
21! ==============
22!
23!  ARGUMENTS
24!  """""""""
25  LOGICAL, INTENT(IN) :: ok_invertp
26  INTEGER, INTENT(IN) :: lmo ! dimensions ancienne couches
27  INTEGER, INTENT(IN) :: lmn ! dimensions nouvelle couches
28 
29  REAL, INTENT(IN) :: po(ni*nj,lmo) ! niveau de pression ancienne grille
30  REAL, INTENT(IN) :: pn(ni*nj,lmn) ! niveau de pression nouvelle grille
31
32  INTEGER, INTENT(IN) :: ni,nj ! nombre de point horizontal
33
34  REAL, INTENT(IN)  :: varo(ni*nj,lmo) ! var dans l'ancienne grille
35  REAL, INTENT(OUT) :: varn(ni*nj,lmn) ! var dans la nouvelle grille
36
37  REAL :: zvaro(ni*nj,lmo),zpo(ni*nj,lmo)
38
39! Autres variables
40! """"""""""""""""
41  INTEGER ::  ln ,lo, k
42  REAL    :: coef
43
44
45! Inversion de l'ordre des niveaux verticaux
46  IF (ok_invertp) THEN
47    DO lo=1,lmo
48      DO k=1,ni*nj
49        zpo(k,lo)=po(k,lmo+1-lo)
50        zvaro(k,lo)=varo(k,lmo+1-lo)
51      ENDDO
52    ENDDO
53  ELSE
54    DO lo=1,lmo
55      DO k=1,ni*nj
56        zpo(k,lo)=po(k,lo)
57        zvaro(k,lo)=varo(k,lo)
58      ENDDO
59    ENDDO
60  ENDIF
61
62  DO ln=1,lmn
63    DO lo=1,lmo-1
64      DO k=1,ni*nj
65        IF (pn(k,ln) >= zpo(k,1) ) THEN
66          varn(k,ln) = zvaro(k,1)
67        ELSE IF (pn(k,ln) <= zpo(k,lmo)) THEN
68          varn(k,ln) = zvaro(k,lmo)
69        ELSE IF ( pn(k,ln) <= zpo(k,lo) .AND. pn(k,ln) > zpo(k,lo+1) ) THEN
70          coef = (pn(k,ln)-zpo(k,lo)) / (zpo(k,lo+1)-zpo(k,lo))
71          varn(k,ln) = zvaro(k,lo) + coef*(zvaro(k,lo+1)-zvaro(k,lo))
72        ENDIF
73         
74      ENDDO 
75    ENDDO
76  ENDDO               
77
78END SUBROUTINE pres2lev   
79
80END MODULE pres2lev_mod
Note: See TracBrowser for help on using the repository browser.