58 #include "abor1.intfb.h"
65 & ldreqout,lders,ld5,ldt1,ldgpingp,ldtrajio,ldthermact,pr,prcp)
101 CHARACTER(LEN=16),
INTENT(IN) :: CDNAME
102 INTEGER(KIND=JPIM),
INTENT(IN) :: KGRIB
103 INTEGER(KIND=JPIM),
INTENT(IN) :: KREQIN
104 REAL(KIND=JPRB),
INTENT(IN),
OPTIONAL :: PREFVALI
105 LOGICAL,
INTENT(IN):: LDREQOUT
106 LOGICAL,
INTENT(IN) :: LDGP
107 LOGICAL,
INTENT(IN) :: LDERS
108 LOGICAL,
INTENT(IN) :: LD5
109 LOGICAL,
INTENT(IN) :: LDT1
110 LOGICAL,
INTENT(IN),
OPTIONAL :: LDGPINGP
111 LOGICAL,
INTENT(IN),
OPTIONAL :: LDTRAJIO
112 LOGICAL,
INTENT(IN),
OPTIONAL :: LDTHERMACT
113 REAL(KIND=JPRB),
INTENT(IN),
OPTIONAL :: PR
114 REAL(KIND=JPRB),
INTENT(IN),
OPTIONAL :: PRCP
116 INTEGER(KIND=JPIM) :: JGFL, ICURFLDPT, ICURFLDPC
117 LOGICAL,
SAVE :: LLFIRSTCALL = .
true.
118 REAL(KIND=JPRB) :: ZHOOK_HANDLE
127 IF (
lhook)
CALL dr_hook(
'GFL_SUBS:DEFINE_GFL_COMP',0,zhook_handle)
171 llfirstcall = .
false.
181 DO jgfl=1,
ygfl%NUMFLDS
182 IF(.NOT.
ygflc(jgfl)%LGP)
THEN
184 CALL abor1(
'YOMMFL:DEFINE_GFL_COMP:GRIDPOINT BEFORE SPECTRAL')
191 CALL abor1(
'YOMMFL:DEFINE_GFL_COMP:DERIVATIVES ONLY WITH SPECTRAL')
195 WRITE(nulout,*)
' MAXIMUM NUMBER OF FIELDS ALREADY DEFINED'
196 CALL abor1(
'YOMMFL: EXCEED NUMBER OF FIELDS')
201 icurfldpt =
ygfl%NUMFLDS+1
202 icurfldpc =
ygfl%NUMFLDS+1
204 ydgflc%LACTIVE = .
true.
205 ydgflc%CNAME = cdname
206 ydgflc%IGRBCODE = kgrib
207 ydgflc%NREQIN = kreqin
208 IF (
PRESENT(prefvali))
THEN
209 ydgflc%REFVALI = prefvali
211 ydgflc%LREQOUT = ldreqout
213 ydgflc%LSP= .NOT. ydgflc%LGP
216 ydgflc%LCDERS = lders
217 IF(
PRESENT(ldgpingp)) ydgflc%LGPINGP=ldgpingp
218 IF(
PRESENT(ldtrajio)) ydgflc%LTRAJIO=ldtrajio
219 IF(
PRESENT(ldthermact)) ydgflc%LTHERMACT=ldthermact
220 IF(ydgflc%LTHERMACT)
THEN
221 IF(.NOT.
PRESENT(pr)) &
222 &
CALL abor1(
'GFL_SUBS:DEFINE_GFL_COMPONENT - PR MISSING')
223 IF(.NOT.
PRESENT(prcp)) &
224 &
CALL abor1(
'GFL_SUBS:DEFINE_GFL_COMPONENT - PRCP MISSING')
231 IF (ydgflc%LT5)
ygfl%NUMFLDS5 =
ygfl%NUMFLDS5+1
233 IF(ydgflc%LCDERS)
THEN
237 IF (ydgflc%LT5)
ygfl%NDIM5 =
ygfl%NDIM5+3
241 IF (ydgflc%LT5)
ygfl%NDIM5 =
ygfl%NDIM5+1
253 IF (ydgflc%LSP)
ygfl%NUMSPFLDS1 =
ygfl%NUMSPFLDS1+1
257 ydgflc%MP5 = -huge(
jpgfl)
259 ydgflc%MP =
ygfl%NDIM0
260 IF (ydgflc%LT5) ydgflc%MP5 =
ygfl%NDIM5
262 ydgflc%MP =
ygfl%NUMFLDS
263 IF (ydgflc%LT5) ydgflc%MP5 =
ygfl%NUMFLDS5
265 IF (ydgflc%LCDERS)
THEN
266 ydgflc%MPM = ydgflc%MP+
ygfl%NDERS
267 ydgflc%MPL = ydgflc%MP+2*
ygfl%NDERS
269 ydgflc%MP5M = ydgflc%MP5+
ygfl%NDERS
270 ydgflc%MP5L = ydgflc%MP5+2*
ygfl%NDERS
273 ydgflc%MPL = -huge(
jpgfl)
274 ydgflc%MPM = -huge(
jpgfl)
275 ydgflc%MP5L = -huge(
jpgfl)
276 ydgflc%MP5M = -huge(
jpgfl)
280 ydgflc%MPSP =
ygfl%NUMSPFLDS
282 ydgflc%MPSP = -huge(
jpgfl)
286 ydgflc%MP1 =
ygfl%NUMFLDS1
288 ydgflc%MP1 = -huge(
jpgfl)
297 IF(
yptrc%LCDERS)
THEN
305 WRITE(nulout,*)
' DEFINE_GFL_COMP:CHECKING ',
yptrc%CNAME
306 WRITE(nulout,*)
' REASSIGNED MPL=',
yptrc%MPL,
' MPM=',
yptrc%MPM
309 IF(
yptrc%LCDERS)
THEN
317 WRITE(nulout,*)
' REASSIGNED MP5L=',
yptrc%MP5L,
' MP5M=',
yptrc%MP5M
322 IF(.NOT.
ASSOCIATED(
yptrc%PREVIOUS))
EXIT
330 IF (
lhook)
CALL dr_hook(
'GFL_SUBS:DEFINE_GFL_COMP',1,zhook_handle)
337 SUBROUTINE set_gfl_attr(YDGFLC,LDADV,LDT9,LDPHY,LDPT,LDPC,LDADJUST0,&
338 & ldadjust1,kcoupling,prefvalc,ldbiper,cdslint)
373 LOGICAL,
INTENT(IN),
OPTIONAL :: LDADV
374 LOGICAL,
INTENT(IN),
OPTIONAL :: LDT9
375 LOGICAL,
INTENT(IN),
OPTIONAL :: LDPHY
376 LOGICAL,
INTENT(IN),
OPTIONAL :: LDPT
377 LOGICAL,
INTENT(IN),
OPTIONAL :: LDPC
378 LOGICAL,
INTENT(IN),
OPTIONAL :: LDADJUST0
379 LOGICAL,
INTENT(IN),
OPTIONAL :: LDADJUST1
380 INTEGER(KIND=JPIM),
INTENT(IN),
OPTIONAL :: KCOUPLING
381 REAL(KIND=JPRB),
INTENT(IN),
OPTIONAL :: PREFVALC
382 LOGICAL,
INTENT(IN),
OPTIONAL :: LDBIPER
383 CHARACTER(LEN=12),
INTENT(IN),
OPTIONAL :: CDSLINT
385 INTEGER(KIND=JPIM) :: IGFLPTR
386 REAL(KIND=JPRB) :: ZHOOK_HANDLE
390 IF (
lhook)
CALL dr_hook(
'GFL_SUBS:SET_GFL_ATTR',0,zhook_handle)
391 IF(ydgflc%MP < 1 .OR. ydgflc%MP >
ygfl%NUMFLDS)
THEN
392 CALL abor1(
'SET_GFL_ATTR: GFL COMPONENT NOT SET UP')
397 IF(
PRESENT(ldadv))
THEN
401 IF(.NOT.ydgflc%LT1)
THEN
402 CALL abor1(
' GFL field to be advected but LT1=false')
404 ygfl%NUMFLDS_SL1 =
ygfl%NUMFLDS_SL1+1
405 ydgflc%MP_SL1 =
ygfl%NUMFLDS_SL1
412 IF(
PRESENT(ldt9))
THEN
415 IF(ydgflc%LT9 .AND. ydgflc%MP9 == -huge(
jpgfl) )
THEN
419 ydgflc%MP9 =
ygfl%NDIM0+
ygfl%NUMFLDS9
420 ydgflc%MP9_PH = ydgflc%MP9
422 ydgflc%MP9 = ydgflc%MP
423 ydgflc%MP9_PH = ydgflc%MP9
424 WRITE(nulout,*)
'WARNING YDGFLC%MP9 = YDGFLC%MP',ydgflc%MP9,ydgflc%MP
427 IF(
PRESENT(ldphy))
THEN
431 IF(ydgflc%MPSLP == -huge(
jpgfl))
THEN
433 IF(.NOT.ydgflc%LT1)
THEN
434 CALL abor1(
' GFL field to be modified by physics but LT1=false')
438 ydgflc%MPSLP =
ygfl%NUMFLDSPHY
442 IF(
PRESENT(ldpt))
THEN
445 IF(ydgflc%MPPT == -huge(
jpgfl))
THEN
449 ydgflc%MPPT =
ygfl%NUMFLDSPT
452 IF(
PRESENT(ldpc))
THEN
455 IF(ydgflc%MPPC == -huge(
jpgfl))
THEN
459 ydgflc%MPPC =
ygfl%NUMFLDSPC
466 IF(
PRESENT(ldadjust0))
THEN
467 ydgflc%LADJUST0 = ldadjust0
469 IF(
PRESENT(ldadjust1))
THEN
470 ydgflc%LADJUST1 = ldadjust1
472 IF(
PRESENT(kcoupling))
THEN
473 ydgflc%NCOUPLING = kcoupling
475 IF(
PRESENT(prefvalc))
THEN
476 ydgflc%REFVALC = prefvalc
478 IF(
PRESENT(ldbiper))
THEN
479 ydgflc%LBIPER = ldbiper
482 IF(
PRESENT(cdslint))
THEN
483 ydgflc%CSLINT=cdslint
484 IF(ydgflc%MP_SPL == -huge(
jpgfl))
THEN
485 IF(cdslint ==
'LAITVSPCQM ')
THEN
486 ygfl%NUMFLDS_SPL =
ygfl%NUMFLDS_SPL+1
488 ydgflc%MP_SPL =
ygfl%NUMFLDS_SPL
492 IF (
lhook)
CALL dr_hook(
'GFL_SUBS:SET_GFL_ATTR',1,zhook_handle)
505 REAL(KIND=JPRB) :: ZHOOK_HANDLE
506 IF (
lhook)
CALL dr_hook(
'GFL_SUBS:PRINT_GFL',0,zhook_handle)
507 WRITE(nulout,*)
' ---- GFL COMPONENT ATTRIBUTES ----'
511 WRITE(nulout,*)
' GFL COMPONENT DEFINED - NAME=',&
513 WRITE(nulout,*)
' LGP=',
yptrc%LGP,
' NREQIN=',
yptrc%NREQIN, &
514 &
' LREQOUT=',
yptrc%LREQOUT,
' REFVALI=',
yptrc%REFVALI, &
515 &
' LCDERS=',
yptrc%LCDERS,
' LADV=',
yptrc%LADV, &
517 WRITE(nulout,*)
' LADJUST0=',
yptrc%LADJUST0,
' LADJUST1=',
yptrc%LADJUST1,&
518 &
' NCOUPLING=',
yptrc%NCOUPLING,
' REFVALC=',
yptrc%REFVALC,&
519 &
' LBIPER=',
yptrc%LBIPER
520 WRITE(nulout,*)
' LTRAJIO=',
yptrc%LTRAJIO,
' LGPINGP=',
yptrc%LGPINGP
521 WRITE(nulout,*)
' CSLINT=',
yptrc%CSLINT
522 WRITE(nulout,*)
'LTHERMACT=',
yptrc%LTHERMACT,&
524 WRITE(nulout,*)
' MP=',
yptrc%MP,
' MPL=',
yptrc%MPL,&
529 IF(.NOT.
ASSOCIATED(
yptrc%PREVIOUS))
EXIT
534 WRITE(nulout,*)
' ---- YGFL ATTRIBUTES ----'
535 WRITE(nulout,*)
' YGFL%NUMFLDS=',
ygfl%NUMFLDS,&
536 &
' YGFL%NUMSPFLDS=',
ygfl%NUMSPFLDS,
' YGFL%NUMGPFLDS=',
ygfl%NUMGPFLDS,&
537 &
' YGFL%NDERS=',
ygfl%NDERS,
' YGFL%NUMFLDSPT=',
ygfl%NUMFLDSPT,&
538 &
' YGFL%NUMFLDSPC=',
ygfl%NUMFLDSPC
539 WRITE(nulout,*)
' YGFL%NUMFLDS_SL1=',
ygfl%NUMFLDS_SL1
540 WRITE(nulout,*)
' YGFL%NDIM=',
ygfl%NDIM,
' YGFL%NDIM0=',
ygfl%NDIM0,&
541 &
' YGFL%NDIM9=',
ygfl%NDIM9,
' YGFL%NDIM1=',
ygfl%NDIM1,&
542 &
' YGFL%NDIM5=',
ygfl%NDIM5,
' YGFL%NDIMSLP=',
ygfl%NDIMSLP,&
543 &
' YGFL%NDIMPT=',
ygfl%NDIMPT,
' YGFL%NDIMPC=',
ygfl%NDIMPC
577 WRITE(nulout,*)
' --------------------------------------------'
578 IF (
lhook)
CALL dr_hook(
'GFL_SUBS:PRINT_GFL',1,zhook_handle)
719 REAL(KIND=JPRB) :: ZHOOK_HANDLE
721 IF (
lhook)
CALL dr_hook(
'GFL_SUBS:FALSIFY_GFLC',0,zhook_handle)
723 ydgflc%IGRBCODE = -huge(
jpgfl)
724 ydgflc%LADV = .
false.
726 ydgflc%REFVALI = 0.0_jprb
727 ydgflc%LREQOUT = .
false.
728 ydgflc%LGPINGP = .
true.
729 ydgflc%LTRAJIO = .
false.
732 ydgflc%LCDERS = .
false.
733 ydgflc%LACTIVE = .
false.
734 ydgflc%LTHERMACT = .
false.
738 ydgflc%LPHY = .
false.
741 ydgflc%LADJUST0 = .
false.
742 ydgflc%LADJUST1 = .
false.
744 ydgflc%REFVALC = 0.0_jprb
745 ydgflc%LBIPER = .
false.
748 ydgflc%RCP = 0.0_jprb
763 IF (
lhook)
CALL dr_hook(
'GFL_SUBS:FALSIFY_GFLC',1,zhook_handle)
784 REAL(KIND=JPRB) :: ZHOOK_HANDLE
786 IF (
lhook)
CALL dr_hook(
'GFL_SUBS:NOADVECT_GFLC',0,zhook_handle)
787 ydgflc%LADV = .
false.
788 ydgflc%LCDERS = .
false.
791 ydgflc%LPHY = .
false.
793 ydgflc%LADJUST0 = .
false.
794 ydgflc%LADJUST1 = .
false.
795 ydgflc%LBIPER = .
false.
797 IF (
lhook)
CALL dr_hook(
'GFL_SUBS:NOADVECT_GFLC',1,zhook_handle)
820 REAL(KIND=JPRB) :: ZHOOK_HANDLE
822 IF (
lhook)
CALL dr_hook(
'GFL_SUBS:COPY_GFLC_GFLC',0,zhook_handle)
823 ydgflc1%CNAME = ydgflc2%CNAME
824 ydgflc1%IGRBCODE = ydgflc2%IGRBCODE
825 ydgflc1%LADV = ydgflc2%LADV
826 ydgflc1%NREQIN = ydgflc2%NREQIN
827 ydgflc1%REFVALI = ydgflc2%REFVALI
828 ydgflc1%LREQOUT = ydgflc2%LREQOUT
829 ydgflc1%LGPINGP = ydgflc2%LGPINGP
830 ydgflc1%LTRAJIO = ydgflc2%LTRAJIO
831 ydgflc1%LGP = ydgflc2%LGP
832 ydgflc1%LSP = ydgflc2%LSP
833 ydgflc1%LPT = ydgflc2%LPT
834 ydgflc1%LPC = ydgflc2%LPC
835 ydgflc1%LCDERS = ydgflc2%LCDERS
836 ydgflc1%LACTIVE = ydgflc2%LACTIVE
837 ydgflc1%LTHERMACT = ydgflc2%LTHERMACT
838 ydgflc1%LT9 = ydgflc2%LT9
839 ydgflc1%LT1 = ydgflc2%LT1
840 ydgflc1%LT5 = ydgflc2%LT5
841 ydgflc1%LPHY = ydgflc2%LPHY
842 ydgflc1%LADJUST0 = ydgflc2%LADJUST0
843 ydgflc1%LADJUST1 = ydgflc2%LADJUST1
844 ydgflc1%NCOUPLING = ydgflc2%NCOUPLING
845 ydgflc1%REFVALC = ydgflc2%REFVALC
846 ydgflc1%LBIPER = ydgflc2%LBIPER
847 ydgflc1%CSLINT = ydgflc2%CSLINT
848 ydgflc1%R = ydgflc2%R
849 ydgflc1%RCP = ydgflc2%RCP
850 ydgflc1%MP = ydgflc2%MP
851 ydgflc1%MPL = ydgflc2%MPL
852 ydgflc1%MPM = ydgflc2%MPM
853 ydgflc1%MP9 = ydgflc2%MP9
854 ydgflc1%MP1 = ydgflc2%MP1
855 ydgflc1%MP5 = ydgflc2%MP5
856 ydgflc1%MP5L = ydgflc2%MP5L
857 ydgflc1%MP5M = ydgflc2%MP5M
858 ydgflc1%MPSLP = ydgflc2%MPSLP
859 ydgflc1%MP_SPL = ydgflc2%MP_SPL
860 ydgflc1%MP_SL1 = ydgflc2%MP_SL1
861 ydgflc1%MPSP = ydgflc2%MPSP
862 ydgflc1%MPPT = ydgflc2%MPPT
863 ydgflc1%MPPC = ydgflc2%MPPC
865 IF (
lhook)
CALL dr_hook(
'GFL_SUBS:COPY_GFLC_GFLC',1,zhook_handle)
type(type_gfl_comp), pointer ycpf
type(type_gfl_comp), pointer yr
subroutine, public define_gfl_comp(YDGFLC, CDNAME, KGRIB, LDGP, KREQIN, PREFVALI, LDREQOUT, LDERS, LD5, LDT1, LDGPINGP, LDTRAJIO, LDTHERMACT, PR, PRCP)
subroutine falsify_gflc(YDGFLC)
type(type_gfl_comp) ycpf_save
type(type_gfl_comp) ya_save
type(type_gfl_comp), pointer yl
integer(kind=jpim) msavtend_s
type(type_gfl_comp), pointer ys
integer(kind=jpim) nflevg
subroutine, public set_gfl_attr(YDGFLC, LDADV, LDT9, LDPHY, LDPT, LDPC, LDADJUST0, LDADJUST1, KCOUPLING, PREFVALC, LDBIPER, CDSLINT)
subroutine, public print_gfl
subroutine copy_gflc_gflc(YDGFLC1, YDGFLC2)
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL false
type(type_gfl_comp) yi_save
type(type_gfl_comp) ys_save
subroutine noadvect_gflc(YDGFLC)
type(type_gfl_comp), pointer yptrc
integer(kind=jpim), parameter jpgfl
type(type_gfl_comp), pointer ya
type(type_gfl_comp), pointer yi
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL ulevSTD CALL &zphi philevSTD CALL &zx_rh rhlevSTD!DO klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon du jour ou toutes les read_climoz CALL true
type(type_gfl_comp), pointer ylastgflc
subroutine dr_hook(CDNAME, KSWITCH, PKEY)
type(type_gfl_comp), dimension(jpgfl), target ygflc
type(type_gfl_comp) yr_save
integer(kind=jpim) nflsul
type(type_gfl_comp) yl_save