Ignore:
Timestamp:
Feb 7, 2005, 4:47:11 PM (20 years ago)
Author:
Laurent Fairhead
Message:

Modifications pour le couplage carbone LOOP, PC
LF

Location:
LMDZ4/branches/IPSL-CM4_IPCC_patches/libf/phylmd
Files:
7 edited

Legend:

Unmodified
Added
Removed
  • LMDZ4/branches/IPSL-CM4_IPCC_patches/libf/phylmd/clmain.F

    r524 r589  
    230230c
    231231      REAL yt2m(klon), yq2m(klon), yu10m(klon)
     232c -- LOOP
     233       REAL yu10mx(klon)
     234       REAL yu10my(klon)
     235       REAL ywindsp(klon)
     236c -- LOOP
    232237c
    233238      REAL uzon(klon), vmer(klon)
     
    340345      ytsoil = 999999.
    341346      yrugoro = 0.
    342 
     347c -- LOOP
     348      yu10mx = 0.0
     349      yu10my = 0.0
     350      ywindsp = 0.0
     351c -- LOOP
    343352      DO nsrf = 1, nbsrf
    344353      DO i = 1, klon
     
    447456        ypaprs(j,klev+1) = paprs(i,klev+1)
    448457        y_run_off_lic_0(j) = run_off_lic_0(i)
     458c -- LOOP
     459       yu10mx(j) = u10m(i,nsrf)
     460       yu10my(j) = v10m(i,nsrf)
     461       ywindsp(j) = SQRT(yu10mx(j)*yu10mx(j) + yu10my(j)*yu10my(j) )
     462c -- LOOP
    449463      END DO
    450464C
     
    555569     e          yt,yq,yts,ypaprs,ypplay,
    556570     e          ydelp,yrads,yalb, yalblw, ysnow, yqsurf,
    557      e          yrain_f, ysnow_f, yfder, ytaux, ytauy,
     571     e          yrain_f, ysnow_f, yfder, ytaux, ytauy,
     572c -- LOOP
     573     e          ywindsp,
     574c -- LOOP
    558575c$$$     e          ysollw, ysolsw,
    559576     e          ysollw, ysollwdown, ysolsw,yfluxlat,
     
    799816     e                delp,radsol,albedo,alblw,snow,qsurf,
    800817     e                precip_rain, precip_snow, fder, taux, tauy,
     818c -- LOOP
     819     e                ywindsp,
     820c -- LOOP
    801821     $                sollw, sollwdown, swnet,fluxlat,
    802822     s                pctsrf_new, agesno,
     
    857877      character*6 ocean
    858878      integer npas, nexca
     879c -- LOOP
     880       REAL yu10mx(klon)
     881       REAL yu10my(klon)
     882       REAL ywindsp(klon)
     883c -- LOOP
     884
    859885
    860886c
     
    10831109     e tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef,
    10841110     e precip_rain, precip_snow, sollw, sollwdown, swnet, swdown,
    1085      e fder, taux, tauy, rugos, rugoro,
     1111     e fder, taux, tauy,
     1112c -- LOOP
     1113     e ywindsp,
     1114c -- LOOP
     1115     e rugos, rugoro,
    10861116     e albedo, snow, qsurf,
    10871117     e ts, p1lay, psref, radsol,
  • LMDZ4/branches/IPSL-CM4_IPCC_patches/libf/phylmd/ini_histhf.h

    r524 r589  
    113113     .                "ave(X)", zsto1,zout)
    114114c
    115 c
     115c -- LOOP
    116116         CALL histdef(nid_hf, "SWdownOR",
    117      .                "Sfce incident SW radiation OR", "W/m^2",
    118      .                iim,jjmp1,nhori, 1,1,1, -99, 32,
    119      .                "ave(X)", zsto1,zout)
     117     .                "Sfce incident SW down radiation OR", "W/m^2",
     118     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
     119     .                "ave(X)", zsto1,zout)
     120c
     121         CALL histdef(nid_hf, "SWnetOR",
     122     .                "Sfce incident SW net radiation OR", "W/m^2",
     123     .                iim,jjmp1,nhori, 1,1,1, -99, 32,
     124     .                "ave(X)", zsto1,zout)
     125c -- LOOP
    120126c
    121127         CALL histdef(nid_hf, "LWdownOR",
  • LMDZ4/branches/IPSL-CM4_IPCC_patches/libf/phylmd/interface_surf.F90

    r524 r589  
    6464      & tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
    6565      & precip_rain, precip_snow, sollw, sollwdown, swnet, swdown, &
    66       & fder, taux, tauy, rugos, rugoro, &
     66      & fder, taux, tauy, &
     67! -- LOOP
     68      & windsp, &
     69! -- LOOP
     70      & rugos, rugoro, &
    6771      & albedo, snow, qsurf, &
    6872      & tsurf, p1lay, ps, radsol, &
     
    127131!   fder         derivee des flux (pour le couplage)
    128132!   taux, tauy   tension de vents
     133! -- LOOP
     134!   windsp       module du vent a 10m
     135! -- LOOP
    129136!   rugos        rugosite
    130137!   zmasq        masque terre/ocean
     
    175182  real, dimension(klon), intent(IN) :: zmasq
    176183  real, dimension(klon), intent(IN) :: taux, tauy, rugos, rugoro
     184! -- LOOP
     185  real, dimension(klon), intent(IN) :: windsp
     186! -- LOOP
    177187  character (len = 6)  :: ocean
    178188  integer              :: npas, nexca ! nombre et pas de temps couplage
     
    440450      & ocean, npas, nexca, debut, lafin, &
    441451      & swdown, sollw, precip_rain, precip_snow, evap, tsurf, &
    442       & fluxlat, fluxsens, fder, albedo, taux, tauy, zmasq, &
    443       & tsurf_new, alb_new, pctsrf_new)
     452      & fluxlat, fluxsens, fder, albedo, taux, tauy, &
     453! -- LOOP
     454      & windsp, &
     455! -- LOOP
     456      & zmasq, &
     457      & tsurf_new, alb_new, &
     458      & pctsrf_new)
    444459
    445460!    else if (ocean == 'slab  ') then
     
    494509      & ocean, npas, nexca, debut, lafin, &
    495510      & swdown, sollw, precip_rain, precip_snow, evap, tsurf, &
    496       & fluxlat, fluxsens, fder, albedo, taux, tauy, zmasq, &
    497       & tsurf_new, alb_new, pctsrf_new)
     511      & fluxlat, fluxsens, fder, albedo, taux, tauy, &
     512! -- LOOP
     513      & windsp, &
     514! -- LOOP
     515      & zmasq, &
     516      & tsurf_new, alb_new, &
     517      & pctsrf_new)
    498518
    499519!    else if (ocean == 'slab  ') then
     
    545565      & ocean, npas, nexca, debut, lafin, &
    546566      & swdown, sollw, precip_rain, precip_snow, evap, tsurf, &
    547       & fluxlat, fluxsens, fder, albedo, taux, tauy, zmasq, &
    548       & tsurf_new, alb_new, pctsrf_new)
     567      & fluxlat, fluxsens, fder, albedo, taux, tauy, &
     568! -- LOOP
     569      & windsp, &
     570! -- LOOP
     571      & zmasq, &
     572      & tsurf_new, alb_new, &
     573      & pctsrf_new)
    549574
    550575      tsurf_temp = tsurf_new
     
    640665      & ocean, npas, nexca, debut, lafin, &
    641666      & swdown, sollw, precip_rain, precip_snow, evap, tsurf, &
    642       & fluxlat, fluxsens, fder, albedo, taux, tauy, zmasq, &
    643       & tsurf_new, alb_new, pctsrf_new)
     667      & fluxlat, fluxsens, fder, albedo, taux, tauy, &
     668! -- LOOP
     669      & windsp, &
     670! -- LOOP
     671      & zmasq, &
     672      & tsurf_new, alb_new, &
     673      & pctsrf_new)
    644674
    645675!    else if (ocean == 'slab  ') then
     
    11941224      & ocean, npas, nexca, debut, lafin, &
    11951225      & swdown, lwdown, precip_rain, precip_snow, evap, tsurf, &
    1196       & fluxlat, fluxsens, fder, albsol, taux, tauy, zmasq, &
    1197       & tsurf_new, alb_new, pctsrf_new)
     1226      & fluxlat, fluxsens, fder, albsol, taux, tauy, &
     1227! -- LOOP
     1228      & windsp, &
     1229! -- LOOP
     1230      & zmasq, &
     1231      & tsurf_new, alb_new, &
     1232      & pctsrf_new)
    11981233
    11991234! Cette routine sert d'interface entre le modele atmospherique et un
     
    12381273!   taux         tension de vent en x
    12391274!   tauy         tension de vent en y
     1275! -- LOOP
     1276!    windsp       module du vent a 10m
     1277! -- LOOP
    12401278!   nexca        frequence de couplage
    12411279!   zmasq        masque terre/ocean
     
    12651303  real, dimension(klon), intent(IN) :: precip_rain, precip_snow
    12661304  real, dimension(klon), intent(IN) :: tsurf, fder, albsol, taux, tauy
     1305! -- LOOP
     1306   real, dimension(klon), intent(IN) :: windsp
     1307! -- LOOP
    12671308  INTEGER              :: nexca, npas, kstep
    12681309  real, dimension(klon), intent(IN) :: zmasq
     
    12771318! Variables locales
    12781319  integer                    :: j, error, sum_error, ig, cpl_index,i
     1320! -- LOOP
     1321  INTEGER :: nsrf
     1322! -- LOOP
    12791323  character (len = 20) :: modname = 'interfoce_cpl'
    12801324  character (len = 80) :: abort_message
     
    12841328  real, allocatable, dimension(:,:),save :: cpl_snow, cpl_evap, cpl_tsol
    12851329  real, allocatable, dimension(:,:),save :: cpl_fder, cpl_albe, cpl_taux
     1330! -- LOOP
     1331  real, allocatable, dimension(:,:),save :: cpl_windsp
     1332! -- LOOP
    12861333  real, allocatable, dimension(:,:),save :: cpl_tauy
    12871334  REAL, ALLOCATABLE, DIMENSION(:,:),SAVE :: cpl_rriv, cpl_rcoa, cpl_rlic
     
    12911338  real, allocatable, dimension(:,:,:),save :: tmp_snow, tmp_evap, tmp_tsol
    12921339  real, allocatable, dimension(:,:,:),save :: tmp_fder, tmp_albe, tmp_taux
     1340! -- LOOP
     1341  real, allocatable, dimension(:,:,:),save :: tmp_windsp
     1342! -- LOOP
    12931343!!$  real, allocatable, dimension(:,:,:),save :: tmp_tauy, tmp_rriv, tmp_rcoa
    12941344  REAL, ALLOCATABLE, DIMENSION(:,:,:),SAVE :: tmp_tauy
     
    12981348  REAL, DIMENSION(iim, jjm+1) :: wri_evap_sea, wri_rcoa, wri_rriv
    12991349  REAL, DIMENSION(iim, jjm+1) :: wri_rain, wri_snow, wri_taux, wri_tauy
     1350! -- LOOP
     1351   REAL, DIMENSION(iim, jjm+1) :: wri_windsp
     1352! -- LOOP
    13001353  REAL, DIMENSION(iim, jjm+1) :: wri_calv
    13011354  REAL, DIMENSION(iim, jjm+1) :: wri_tauxx, wri_tauyy, wri_tauzz
     
    13281381  REAL :: zx_lon(iim,jjm+1), zx_lat(iim,jjm+1), zjulian
    13291382  integer :: idayref, itau_w
     1383! -- LOOP
     1384  integer :: nb_interf_cpl
     1385! -- LOOP
    13301386#include "param_cou.h"
    13311387#include "inc_cpl.h"
     
    13631419    allocate(cpl_albe(klon,2), stat = error); sum_error = sum_error + error
    13641420    allocate(cpl_taux(klon,2), stat = error); sum_error = sum_error + error
     1421! -- LOOP
     1422     allocate(cpl_windsp(klon,2), stat = error); sum_error = sum_error + error
     1423! -- LOOP
    13651424    allocate(cpl_tauy(klon,2), stat = error); sum_error = sum_error + error
    13661425    ALLOCATE(cpl_rriv(iim,jjm+1), stat=error); sum_error = sum_error + error
     
    13801439    cpl_evap = 0.; cpl_tsol = 0.; cpl_fder = 0.; cpl_albe = 0.
    13811440    cpl_taux = 0.; cpl_tauy = 0.; cpl_rriv = 0.; cpl_rcoa = 0.; cpl_rlic = 0.
     1441! -- LOOP
     1442     cpl_windsp = 0.
     1443! -- LOOP
    13821444
    13831445    sum_error = 0
     
    14541516
    14551517! calcul des fluxs a passer
    1456 
     1518! -- LOOP
     1519  nb_interf_cpl = nb_interf_cpl + 1 
     1520  if (check) write(*,*)'passage dans interface_surf.F90 :  ',nb_interf_cpl
     1521! -- LOOP
    14571522  cpl_index = 1
    14581523  if (nisurf == is_sic) cpl_index = 2
    14591524  if (cumul) then
     1525! -- LOOP
     1526      if (check) write(*,*)'passage dans cumul '
     1527      if (check) write(*,*)'valeur de cpl_index ', cpl_index
     1528! -- LOOP 
    14601529    if (check) write(*,*) modname, 'cumul des champs'
    14611530    do ig = 1, knon
     
    14811550      cpl_tauy(ig,cpl_index) = cpl_tauy(ig,cpl_index) &
    14821551       &                          + tauy(ig)        / FLOAT(nexca)
     1552! -- LOOP
     1553      IF (cpl_index .EQ. 1) THEN
     1554      cpl_windsp(ig,cpl_index) = cpl_windsp(ig,cpl_index) &
     1555       &                          + windsp(ig)      / FLOAT(nexca)
     1556      ENDIF
     1557! -- LOOP
    14831558    enddo
    14841559    IF (cpl_index .EQ. 1) THEN
     
    15841659      allocate(tmp_taux(iim,jjm+1,2), stat=error); sum_error = sum_error + error
    15851660      allocate(tmp_tauy(iim,jjm+1,2), stat=error); sum_error = sum_error + error
     1661! -- LOOP
     1662       allocate(tmp_windsp(iim,jjm+1,2), stat=error); sum_error = sum_error + error
     1663! -- LOOP
    15861664!!$      allocate(tmp_rriv(iim,jjm+1,2), stat=error); sum_error = sum_error + error
    15871665!!$      allocate(tmp_rcoa(iim,jjm+1,2), stat=error); sum_error = sum_error + error
     
    16061684    call gath2cpl(cpl_albe(1,cpl_index), tmp_albe(1,1,cpl_index), klon, knon,iim,jjm,                  knindex)
    16071685    call gath2cpl(cpl_taux(1,cpl_index), tmp_taux(1,1,cpl_index), klon, knon,iim,jjm,                  knindex)
     1686! -- LOOP
     1687     call gath2cpl(cpl_windsp(1,cpl_index), tmp_windsp(1,1,cpl_index), klon, knon,iim,jjm,             knindex)
     1688! -- LOOP
    16081689    call gath2cpl(cpl_tauy(1,cpl_index), tmp_tauy(1,1,cpl_index), klon, knon,iim,jjm,                  knindex)
    16091690
     
    16141695      wri_rain = 0.; wri_snow = 0.; wri_rcoa = 0.; wri_rriv = 0.
    16151696      wri_taux = 0.; wri_tauy = 0.
     1697! -- LOOP
     1698       wri_windsp = 0.
     1699! -- LOOP     
    16161700      call gath2cpl(pctsrf(1,is_oce), tamp_srf(1,1,1), klon, klon, iim, jjm, tamp_ind)
    16171701      call gath2cpl(pctsrf(1,is_sic), tamp_srf(1,1,2), klon, klon, iim, jjm, tamp_ind)
     
    16241708      wri_evap_ice = tmp_evap(:,:,2)
    16251709      wri_evap_sea = tmp_evap(:,:,1)
     1710! -- LOOP
     1711       wri_windsp = tmp_windsp(:,:,1)
     1712! -- LOOP
     1713
    16261714!!$PB
    16271715      wri_rriv = cpl_rriv(:,:)
     
    16771765! envoi au coupleur
    16781766!
    1679       CALL histwrite(nidct,cl_writ(1),itau_w,wri_sol_ice,iim*(jjm+1),ndexct)
    1680       CALL histwrite(nidct,cl_writ(2),itau_w,wri_sol_sea,iim*(jjm+1),ndexct)
    1681       CALL histwrite(nidct,cl_writ(3),itau_w,wri_nsol_ice,iim*(jjm+1),ndexct)
    1682       CALL histwrite(nidct,cl_writ(4),itau_w,wri_nsol_sea,iim*(jjm+1),ndexct)
    1683       CALL histwrite(nidct,cl_writ(5),itau_w,wri_fder_ice,iim*(jjm+1),ndexct)
    1684       CALL histwrite(nidct,cl_writ(6),itau_w,wri_evap_ice,iim*(jjm+1),ndexct)
    1685       CALL histwrite(nidct,cl_writ(7),itau_w,wri_evap_sea,iim*(jjm+1),ndexct)
    1686       CALL histwrite(nidct,cl_writ(8),itau_w,wri_rain,iim*(jjm+1),ndexct)
    1687       CALL histwrite(nidct,cl_writ(9),itau_w,wri_snow,iim*(jjm+1),ndexct)
    1688       CALL histwrite(nidct,cl_writ(10),itau_w,wri_rcoa,iim*(jjm+1),ndexct)
    1689       CALL histwrite(nidct,cl_writ(11),itau_w,wri_rriv,iim*(jjm+1),ndexct)
    1690       CALL histwrite(nidct,cl_writ(12),itau_w,wri_calv,iim*(jjm+1),ndexct)
    1691       CALL histwrite(nidct,cl_writ(13),itau_w,wri_tauxx,iim*(jjm+1),ndexct)
    1692       CALL histwrite(nidct,cl_writ(14),itau_w,wri_tauyy,iim*(jjm+1),ndexct)
    1693       CALL histwrite(nidct,cl_writ(15),itau_w,wri_tauzz,iim*(jjm+1),ndexct)
    1694       CALL histwrite(nidct,cl_writ(16),itau_w,wri_tauxx,iim*(jjm+1),ndexct)
    1695       CALL histwrite(nidct,cl_writ(17),itau_w,wri_tauyy,iim*(jjm+1),ndexct)
    1696       CALL histwrite(nidct,cl_writ(18),itau_w,wri_tauzz,iim*(jjm+1),ndexct)
     1767      CALL histwrite(nidct,cl_writ(8),itau_w,wri_sol_ice,iim*(jjm+1),ndexct)
     1768      CALL histwrite(nidct,cl_writ(9),itau_w,wri_sol_sea,iim*(jjm+1),ndexct)
     1769      CALL histwrite(nidct,cl_writ(10),itau_w,wri_nsol_ice,iim*(jjm+1),ndexct)
     1770      CALL histwrite(nidct,cl_writ(11),itau_w,wri_nsol_sea,iim*(jjm+1),ndexct)
     1771      CALL histwrite(nidct,cl_writ(12),itau_w,wri_fder_ice,iim*(jjm+1),ndexct)
     1772      CALL histwrite(nidct,cl_writ(13),itau_w,wri_evap_ice,iim*(jjm+1),ndexct)
     1773      CALL histwrite(nidct,cl_writ(14),itau_w,wri_evap_sea,iim*(jjm+1),ndexct)
     1774      CALL histwrite(nidct,cl_writ(15),itau_w,wri_rain,iim*(jjm+1),ndexct)
     1775      CALL histwrite(nidct,cl_writ(16),itau_w,wri_snow,iim*(jjm+1),ndexct)
     1776      CALL histwrite(nidct,cl_writ(17),itau_w,wri_rcoa,iim*(jjm+1),ndexct)
     1777      CALL histwrite(nidct,cl_writ(18),itau_w,wri_rriv,iim*(jjm+1),ndexct)
     1778      CALL histwrite(nidct,cl_writ(19),itau_w,wri_calv,iim*(jjm+1),ndexct)
     1779      CALL histwrite(nidct,cl_writ(1),itau_w,wri_tauxx,iim*(jjm+1),ndexct)
     1780      CALL histwrite(nidct,cl_writ(2),itau_w,wri_tauyy,iim*(jjm+1),ndexct)
     1781      CALL histwrite(nidct,cl_writ(3),itau_w,wri_tauzz,iim*(jjm+1),ndexct)
     1782      CALL histwrite(nidct,cl_writ(4),itau_w,wri_tauxx,iim*(jjm+1),ndexct)
     1783      CALL histwrite(nidct,cl_writ(5),itau_w,wri_tauyy,iim*(jjm+1),ndexct)
     1784      CALL histwrite(nidct,cl_writ(6),itau_w,wri_tauzz,iim*(jjm+1),ndexct)
     1785! -- LOOP
     1786      CALL histwrite(nidct,cl_writ(7),itau_w,wri_windsp,iim*(jjm+1),ndexct)
     1787! -- LOOP
    16971788      CALL histsync(nidct)
    16981789! pas utile      IF (lafin) CALL histclo(nidct)
     1790! -- LOOP
    16991791      call intocpl(itime, (jjm+1)*iim, wri_sol_ice, wri_sol_sea, wri_nsol_ice,&
    17001792      & wri_nsol_sea, wri_fder_ice, wri_evap_ice, wri_evap_sea, wri_rain, &
    17011793      & wri_snow, wri_rcoa, wri_rriv, wri_calv, wri_tauxx, wri_tauyy,     &
    1702       & wri_tauzz, wri_tauxx, wri_tauyy, wri_tauzz,lafin )
    1703 !
     1794      & wri_tauzz, wri_tauxx, wri_tauyy, wri_tauzz,wri_windsp,lafin)
     1795! -- LOOP
    17041796      cpl_sols = 0.; cpl_nsol = 0.; cpl_rain = 0.; cpl_snow = 0.
    17051797      cpl_evap = 0.; cpl_tsol = 0.; cpl_fder = 0.; cpl_albe = 0.
    17061798      cpl_taux = 0.; cpl_tauy = 0.; cpl_rriv = 0.; cpl_rcoa = 0.; cpl_rlic = 0.
     1799! -- LOOP
     1800      cpl_windsp = 0.
     1801! -- LOOP
    17071802!
    17081803! deallocation memoire variables temporaires
     
    17191814      deallocate(tmp_taux, stat=error); sum_error = sum_error + error
    17201815      deallocate(tmp_tauy, stat=error); sum_error = sum_error + error
     1816! -- LOOP
     1817      deallocate(tmp_windsp, stat=error); sum_error = sum_error + error
     1818! -- LOOP
    17211819!!$PB
    17221820!!$      deallocate(tmp_rriv, stat=error); sum_error = sum_error + error
  • LMDZ4/branches/IPSL-CM4_IPCC_patches/libf/phylmd/oasis.dummy

    r524 r589  
    2020c     INCLUDE "param.h"
    2121c
    22       INTEGER kastp, kexch, kstep,imjm
     22      INTEGER kastp, kexch, kstep,imjm,klon
    2323      INTEGER iparal(3)
    2424      INTEGER ifcpl, idt, info, imxtag, istep, jf
     25
     26c -- LOOP
     27c
     28#include "dimensions.h"
     29      INTEGER jjmp1
     30      PARAMETER (jjmp1=jjm+1-1/jjm)
     31#include "dimphy.h"
     32       REAL zwindsp(klon)
     33c
     34c -- LOOP
    2535c
    2636#include "param_cou.h"
     
    7282c         must be the same as (1) of the field  definition in namcouple:
    7383c
    74       cl_writ(1)='COSHFICE'
    75       cl_writ(2)='COSHFOCE'
    76       cl_writ(3)='CONSFICE'
    77       cl_writ(4)='CONSFOCE'
    78       cl_writ(5)='CODFLXDT'
     84      cl_writ(8)='COSHFICE'
     85      cl_writ(9)='COSHFOCE'
     86      cl_writ(10)='CONSFICE'
     87      cl_writ(11)='CONSFOCE'
     88      cl_writ(12)='CODFLXDT'
    7989c      cl_writ(6)='COICTEMP'
    80       cl_writ(6)='COTFSICE'
    81       cl_writ(7)='COTFSOCE'
    82       cl_writ(8)='COTOLPSU'
    83       cl_writ(9)='COTOSPSU'
    84       cl_writ(10)='CORUNCOA'
    85       cl_writ(11)='CORIVFLU'
    86       cl_writ(12)='COCALVIN'
     90      cl_writ(13)='COTFSICE'
     91      cl_writ(14)='COTFSOCE'
     92      cl_writ(15)='COTOLPSU'
     93      cl_writ(16)='COTOSPSU'
     94      cl_writ(17)='CORUNCOA'
     95      cl_writ(18)='CORIVFLU'
     96      cl_writ(19)='COCALVIN'
    8797c$$$      cl_writ(13)='COZOTAUX'
    8898c$$$      cl_writ(14)='COZOTAUV'
    8999c$$$      cl_writ(15)='COMETAUY'
    90100c$$$      cl_writ(16)='COMETAUU'
    91       cl_writ(13)='COTAUXXU'
    92       cl_writ(14)='COTAUYYU'
    93       cl_writ(15)='COTAUZZU'
    94       cl_writ(16)='COTAUXXV'
    95       cl_writ(17)='COTAUYYV'
    96       cl_writ(18)='COTAUZZV'
     101      cl_writ(1)='COTAUXXU'
     102      cl_writ(2)='COTAUYYU'
     103      cl_writ(3)='COTAUZZU'
     104      cl_writ(4)='COTAUXXV'
     105      cl_writ(5)='COTAUYYV'
     106      cl_writ(6)='COTAUZZV'
     107c -- LOOP
     108      cl_writ(7)='COWINDSP'
     109c -- LOOP
    97110c
    98111c     Define files name for fields exchanged from atmos to coupler,
     
    117130      cl_f_writ(17)='flxatmos'
    118131      cl_f_writ(18)='flxatmos'
     132c -- LOOP
     133      cl_f_writ(19)='flxatmos'
     134c -- LOOP
    119135
    120136c
     
    312328      SUBROUTINE intocpl(kt, imjm, fsolice, fsolwat, fnsolice, fnsolwat,
    313329     $    fnsicedt, evice, evwat, lpre, spre, dirunoff, rivrunoff,
    314      $    calving, tauxx_u, tauyy_u, tauzz_u, tauxx_v, tauyy_v, tauzz_v
    315      $    , last)
     330     $    calving, tauxx_u, tauyy_u, tauzz_u, tauxx_v, tauyy_v, tauzz_v,
     331     $    windsp, last)
     332c -- LOOP
    316333c ======================================================================
    317334c S. Valcke (02/99) adapted From L.Z.X Li: this subroutine provides the
     
    321338c ======================================================================
    322339      IMPLICIT NONE
     340c -- LOOP
     341c
     342#include "dimensions.h"
     343      INTEGER jjmp1
     344      PARAMETER (jjmp1=jjm+1-1/jjm)
     345#include "dimphy.h"
     346c      REAL zu10m(klon), zv10m(klon)
     347       REAL zwindsp(klon)
     348c
     349c -- LOOP
     350c
     351
    323352      INTEGER kt, imjm
    324353c
     
    345374      REAL tauzz_u(imjm)
    346375      REAL tauzz_v(imjm)
     376c -- LOOP
     377       REAL windsp(imjm)
     378c -- LOOP
    347379      LOGICAL last
    348380c
     
    424456c         WRITE fields to files         
    425457          DO jf=1, jpflda2o1 + jpflda2o2
    426             IF (jf.eq.1)
     458            IF (jf.eq.8)
    427459     $          CALL locwrite(cl_writ(jf),fsolice, imjm,
    428460     $          file_unit_field(jf), ierror)
    429             IF (jf.eq.2)
     461            IF (jf.eq.9)
    430462     $          CALL locwrite(cl_writ(jf),fsolwat, imjm,
    431463     $          file_unit_field(jf), ierror)
    432             IF (jf.eq.3)
     464            IF (jf.eq.10)
    433465     $          CALL locwrite(cl_writ(jf),fnsolice, imjm,
    434466     $          file_unit_field(jf), ierror)
    435             IF (jf.eq.4)
     467            IF (jf.eq.11)
    436468     $          CALL locwrite(cl_writ(jf),fnsolwat, imjm,
    437469     $          file_unit_field(jf), ierror)
    438             IF (jf.eq.5)
     470            IF (jf.eq.12)
    439471     $          CALL locwrite(cl_writ(jf),fnsicedt, imjm,
    440472     $          file_unit_field(jf), ierror)
    441 c            IF (jf.eq.6)
     473c            IF (jf.eq.13)
    442474c     $          CALL locwrite(cl_writ(jf),ictemp, imjm,
    443475c     $          file_unit_field(jf), ierror)
    444             IF (jf.eq.6)
     476            IF (jf.eq.13)
    445477     $          CALL locwrite(cl_writ(jf),evice, imjm,
    446478     $          file_unit_field(jf), ierror)
    447             IF (jf.eq.7)
     479            IF (jf.eq.14)
    448480     $          CALL locwrite(cl_writ(jf),evwat, imjm,
    449481     $          file_unit_field(jf), ierror)
    450             IF (jf.eq.8)
     482            IF (jf.eq.15)
    451483     $          CALL locwrite(cl_writ(jf),lpre, imjm,
    452484     $          file_unit_field(jf), ierror)
    453             IF (jf.eq.9)
     485            IF (jf.eq.16)
    454486     $          CALL locwrite(cl_writ(jf),spre, imjm,
    455487     $          file_unit_field(jf), ierror)
    456             IF (jf.eq.10)
     488            IF (jf.eq.17)
    457489     $          CALL locwrite(cl_writ(jf),dirunoff, imjm,
    458490     $          file_unit_field(jf), ierror)
    459             IF (jf.eq.11)
     491            IF (jf.eq.18)
    460492     $          CALL locwrite(cl_writ(jf),rivrunoff, imjm,
    461493     $          file_unit_field(jf), ierror)
    462             IF (jf.eq.12)
     494            IF (jf.eq.19)
    463495     $          CALL locwrite(cl_writ(jf),calving, imjm,
    464496     $          file_unit_field(jf), ierror)
     
    475507c$$$     $          CALL locwrite(cl_writ(jf),tauyu, imjm,
    476508c$$$     $          file_unit_field(jf), ierror)
    477             IF (jf.eq.13)
     509            IF (jf.eq.1)
    478510     $          CALL locwrite(cl_writ(jf),tauxx_u, imjm,
    479511     $          file_unit_field(jf),ierror)
    480             IF (jf.eq.14)
     512            IF (jf.eq.2)
    481513     $          CALL locwrite(cl_writ(jf),tauyy_u, imjm,
    482514     $          file_unit_field(jf),ierror)
    483             IF (jf.eq.15)
     515            IF (jf.eq.3)
    484516     $          CALL locwrite(cl_writ(jf),tauzz_u, imjm,
    485517     $          file_unit_field(jf),ierror)
    486             IF (jf.eq.16)
     518            IF (jf.eq.4)
    487519     $          CALL locwrite(cl_writ(jf),tauxx_v, imjm,
    488520     $          file_unit_field(jf),ierror)
    489             IF (jf.eq.17)
     521            IF (jf.eq.5)
    490522     $          CALL locwrite(cl_writ(jf),tauyy_v, imjm,
    491523     $          file_unit_field(jf),ierror)
    492             IF (jf.eq.18)
     524            IF (jf.eq.6)
    493525     $          CALL locwrite(cl_writ(jf),tauzz_v, imjm,
    494526     $          file_unit_field(jf),ierror)
     527c -- LOOP
     528            IF (jf.eq.7)
     529               CALL locwrite(cl_writ(jf),windsp, imjm,
     530     $         file_unit_field(jf),ierror)
     531c -- LOOP
     532
    495533          END DO
    496534C
     
    522560          DO jn=1, jpflda2o1 + jpflda2o2
    523561C           
    524           IF (jn.eq.1) CALL CLIM_Export(cl_writ(jn), kt, fsolice, info)
    525           IF (jn.eq.2) CALL CLIM_Export(cl_writ(jn), kt, fsolwat, info)
    526           IF (jn.eq.3) CALL CLIM_Export(cl_writ(jn), kt, fnsolice, info)
    527           IF (jn.eq.4) CALL CLIM_Export(cl_writ(jn), kt, fnsolwat, info)
    528           IF (jn.eq.5) CALL CLIM_Export(cl_writ(jn), kt, fnsicedt, info)
     562          IF (jn.eq.8) CALL CLIM_Export(cl_writ(jn), kt, fsolice, info)
     563          IF (jn.eq.9) CALL CLIM_Export(cl_writ(jn), kt, fsolwat, info)
     564         IF (jn.eq.10) CALL CLIM_Export(cl_writ(jn), kt, fnsolice, info)
     565         IF (jn.eq.11) CALL CLIM_Export(cl_writ(jn), kt, fnsolwat, info)
     566         IF (jn.eq.12) CALL CLIM_Export(cl_writ(jn), kt, fnsicedt, info)
    529567c          IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, ictemp, info)
    530           IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, evice, info)
    531           IF (jn.eq.7) CALL CLIM_Export(cl_writ(jn), kt, evwat, info)
    532           IF (jn.eq.8) CALL CLIM_Export(cl_writ(jn), kt, lpre, info)
    533           IF (jn.eq.9) CALL CLIM_Export(cl_writ(jn), kt, spre, info)
    534           IF (jn.eq.10) CALL CLIM_Export(cl_writ(jn),kt,dirunoff, info)
    535           IF (jn.eq.11) CALL CLIM_Export(cl_writ(jn),kt,rivrunoff,info)
    536           IF (jn.eq.12) CALL CLIM_Export(cl_writ(jn),kt,calving,info)
     568          IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, evice, info)
     569          IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, evwat, info)
     570          IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, lpre, info)
     571          IF (jn.eq.16) CALL CLIM_Export(cl_writ(jn), kt, spre, info)
     572          IF (jn.eq.17) CALL CLIM_Export(cl_writ(jn),kt,dirunoff, info)
     573          IF (jn.eq.18) CALL CLIM_Export(cl_writ(jn),kt,rivrunoff,info)
     574          IF (jn.eq.19) CALL CLIM_Export(cl_writ(jn),kt,calving,info)
    537575c$$$          IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, tauxu, info)
    538576c$$$          IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, tauxv, info)
    539577c$$$          IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, tauyv, info)
    540578c$$$          IF (jn.eq.16) CALL CLIM_Export(cl_writ(jn), kt, tauyu, info)
    541           IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, tauxx_u, info)
    542           IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, tauyy_u, info)
    543           IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, tauzz_u, info)
    544           IF (jn.eq.16) CALL CLIM_Export(cl_writ(jn), kt, tauxx_v, info)
    545           IF (jn.eq.17) CALL CLIM_Export(cl_writ(jn), kt, tauyy_v, info)
    546           IF (jn.eq.18) CALL CLIM_Export(cl_writ(jn), kt, tauzz_v, info)
    547          
     579          IF (jn.eq.1) CALL CLIM_Export(cl_writ(jn), kt, tauxx_u, info)
     580          IF (jn.eq.2) CALL CLIM_Export(cl_writ(jn), kt, tauyy_u, info)
     581          IF (jn.eq.3) CALL CLIM_Export(cl_writ(jn), kt, tauzz_u, info)
     582          IF (jn.eq.4) CALL CLIM_Export(cl_writ(jn), kt, tauxx_v, info)
     583          IF (jn.eq.5) CALL CLIM_Export(cl_writ(jn), kt, tauyy_v, info)
     584          IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, tauzz_v, info)
     585c -- LOOP
     586          IF (jn.eq.7) CALL CLIM_Export(cl_writ(jn), kt, windsp, info)
     587c -- LOOP         
    548588            IF (info .NE. CLIM_Ok) THEN
    549589                WRITE (nuout,*) 'STEP : Pb giving ',cl_writ(jn), ':',jn
  • LMDZ4/branches/IPSL-CM4_IPCC_patches/libf/phylmd/oasis.true

    r524 r589  
    2020c     INCLUDE "param.h"
    2121c
    22       INTEGER kastp, kexch, kstep,imjm
     22      INTEGER kastp, kexch, kstep,imjm,klon
    2323      INTEGER iparal(3)
    2424      INTEGER ifcpl, idt, info, imxtag, istep, jf
     25
     26c -- LOOP
     27c
     28#include "dimensions.h"
     29      INTEGER jjmp1
     30      PARAMETER (jjmp1=jjm+1-1/jjm)
     31#include "dimphy.h"
     32c      REAL zu10m(klon), zv10m(klon)
     33       REAL zwindsp(klon)
     34c
     35c -- LOOP
    2536c
    2637#include "param_cou.h"
     
    7182c         must be the same as (1) of the field  definition in namcouple:
    7283c
    73       cl_writ(1)='COSHFICE'
    74       cl_writ(2)='COSHFOCE'
    75       cl_writ(3)='CONSFICE'
    76       cl_writ(4)='CONSFOCE'
    77       cl_writ(5)='CODFLXDT'
     84      cl_writ(8)='COSHFICE'
     85      cl_writ(9)='COSHFOCE'
     86      cl_writ(10)='CONSFICE'
     87      cl_writ(11)='CONSFOCE'
     88      cl_writ(12)='CODFLXDT'
    7889c      cl_writ(6)='COICTEMP'
    79       cl_writ(6)='COTFSICE'
    80       cl_writ(7)='COTFSOCE'
    81       cl_writ(8)='COTOLPSU'
    82       cl_writ(9)='COTOSPSU'
    83       cl_writ(10)='CORUNCOA'
    84       cl_writ(11)='CORIVFLU'
    85       cl_writ(12)='COCALVIN'
     90      cl_writ(13)='COTFSICE'
     91      cl_writ(14)='COTFSOCE'
     92      cl_writ(15)='COTOLPSU'
     93      cl_writ(16)='COTOSPSU'
     94      cl_writ(17)='CORUNCOA'
     95      cl_writ(18)='CORIVFLU'
     96      cl_writ(19)='COCALVIN'
    8697c$$$      cl_writ(13)='COZOTAUX'
    8798c$$$      cl_writ(14)='COZOTAUV'
    8899c$$$      cl_writ(15)='COMETAUY'
    89100c$$$      cl_writ(16)='COMETAUU'
    90       cl_writ(13)='COTAUXXU'
    91       cl_writ(14)='COTAUYYU'
    92       cl_writ(15)='COTAUZZU'
    93       cl_writ(16)='COTAUXXV'
    94       cl_writ(17)='COTAUYYV'
    95       cl_writ(18)='COTAUZZV'
     101      cl_writ(1)='COTAUXXU'
     102      cl_writ(2)='COTAUYYU'
     103      cl_writ(3)='COTAUZZU'
     104      cl_writ(4)='COTAUXXV'
     105      cl_writ(5)='COTAUYYV'
     106      cl_writ(6)='COTAUZZV'
     107c -- LOOP
     108      cl_writ(7)='COWINDSP'
     109c -- LOOP
    96110c
    97111c     Define files name for fields exchanged from atmos to coupler,
     
    116130      cl_f_writ(17)='flxatmos'
    117131      cl_f_writ(18)='flxatmos'
     132c -- LOOP
     133      cl_f_writ(19)='flxatmos'
     134c -- LOOP
    118135
    119136c
     
    309326
    310327c $Id$
     328c -- LOOP
    311329      SUBROUTINE intocpl(kt, imjm, fsolice, fsolwat, fnsolice, fnsolwat,
    312330     $    fnsicedt, evice, evwat, lpre, spre, dirunoff, rivrunoff,
    313      $    calving, tauxx_u, tauyy_u, tauzz_u, tauxx_v, tauyy_v, tauzz_v
    314      $    , last)
     331     $    calving, tauxx_u, tauyy_u, tauzz_u, tauxx_v, tauyy_v, tauzz_v,
     332     $    windsp, last)
     333c -- LOOP
    315334c ======================================================================
    316335c S. Valcke (02/99) adapted From L.Z.X Li: this subroutine provides the
     
    320339c ======================================================================
    321340      IMPLICIT NONE
     341c -- LOOP
     342c
     343#include "dimensions.h"
     344      INTEGER jjmp1
     345      PARAMETER (jjmp1=jjm+1-1/jjm)
     346#include "dimphy.h"
     347c      REAL zu10m(klon), zv10m(klon)
     348       REAL zwindsp(klon)
     349c
     350c -- LOOP
     351c
     352
    322353      INTEGER kt, imjm
    323354c
     
    344375      REAL tauzz_u(imjm)
    345376      REAL tauzz_v(imjm)
     377c -- LOOP
     378       REAL windsp(imjm)
     379c -- LOOP
    346380      LOGICAL last
    347381c
     
    423457c         WRITE fields to files         
    424458          DO jf=1, jpflda2o1 + jpflda2o2
    425             IF (jf.eq.1)
     459            IF (jf.eq.8)
    426460     $          CALL locwrite(cl_writ(jf),fsolice, imjm,
    427461     $          file_unit_field(jf), ierror)
    428             IF (jf.eq.2)
     462            IF (jf.eq.9)
    429463     $          CALL locwrite(cl_writ(jf),fsolwat, imjm,
    430464     $          file_unit_field(jf), ierror)
    431             IF (jf.eq.3)
     465            IF (jf.eq.10)
    432466     $          CALL locwrite(cl_writ(jf),fnsolice, imjm,
    433467     $          file_unit_field(jf), ierror)
    434             IF (jf.eq.4)
     468            IF (jf.eq.11)
    435469     $          CALL locwrite(cl_writ(jf),fnsolwat, imjm,
    436470     $          file_unit_field(jf), ierror)
    437             IF (jf.eq.5)
     471            IF (jf.eq.12)
    438472     $          CALL locwrite(cl_writ(jf),fnsicedt, imjm,
    439473     $          file_unit_field(jf), ierror)
    440 c            IF (jf.eq.6)
     474c            IF (jf.eq.13)
    441475c     $          CALL locwrite(cl_writ(jf),ictemp, imjm,
    442476c     $          file_unit_field(jf), ierror)
    443             IF (jf.eq.6)
     477            IF (jf.eq.13)
    444478     $          CALL locwrite(cl_writ(jf),evice, imjm,
    445479     $          file_unit_field(jf), ierror)
    446             IF (jf.eq.7)
     480            IF (jf.eq.14)
    447481     $          CALL locwrite(cl_writ(jf),evwat, imjm,
    448482     $          file_unit_field(jf), ierror)
    449             IF (jf.eq.8)
     483            IF (jf.eq.15)
    450484     $          CALL locwrite(cl_writ(jf),lpre, imjm,
    451485     $          file_unit_field(jf), ierror)
    452             IF (jf.eq.9)
     486            IF (jf.eq.16)
    453487     $          CALL locwrite(cl_writ(jf),spre, imjm,
    454488     $          file_unit_field(jf), ierror)
    455             IF (jf.eq.10)
     489            IF (jf.eq.17)
    456490     $          CALL locwrite(cl_writ(jf),dirunoff, imjm,
    457491     $          file_unit_field(jf), ierror)
    458             IF (jf.eq.11)
     492            IF (jf.eq.18)
    459493     $          CALL locwrite(cl_writ(jf),rivrunoff, imjm,
    460494     $          file_unit_field(jf), ierror)
    461             IF (jf.eq.12)
     495            IF (jf.eq.19)
    462496     $          CALL locwrite(cl_writ(jf),calving, imjm,
    463497     $          file_unit_field(jf), ierror)
     
    474508c$$$     $          CALL locwrite(cl_writ(jf),tauyu, imjm,
    475509c$$$     $          file_unit_field(jf), ierror)
    476             IF (jf.eq.13)
     510            IF (jf.eq.1)
    477511     $          CALL locwrite(cl_writ(jf),tauxx_u, imjm,
    478512     $          file_unit_field(jf),ierror)
    479             IF (jf.eq.14)
     513            IF (jf.eq.2)
    480514     $          CALL locwrite(cl_writ(jf),tauyy_u, imjm,
    481515     $          file_unit_field(jf),ierror)
    482             IF (jf.eq.15)
     516            IF (jf.eq.3)
    483517     $          CALL locwrite(cl_writ(jf),tauzz_u, imjm,
    484518     $          file_unit_field(jf),ierror)
    485             IF (jf.eq.16)
     519            IF (jf.eq.4)
    486520     $          CALL locwrite(cl_writ(jf),tauxx_v, imjm,
    487521     $          file_unit_field(jf),ierror)
    488             IF (jf.eq.17)
     522            IF (jf.eq.5)
    489523     $          CALL locwrite(cl_writ(jf),tauyy_v, imjm,
    490524     $          file_unit_field(jf),ierror)
    491             IF (jf.eq.18)
     525            IF (jf.eq.6)
    492526     $          CALL locwrite(cl_writ(jf),tauzz_v, imjm,
    493527     $          file_unit_field(jf),ierror)
     528c -- LOOP
     529            IF (jf.eq.7)
     530     $          CALL locwrite(cl_writ(jf),windsp, imjm,
     531     $         file_unit_field(jf),ierror)
     532c -- LOOP
     533
    494534          END DO
    495535C
     
    521561          DO jn=1, jpflda2o1 + jpflda2o2
    522562C           
    523           IF (jn.eq.1) CALL CLIM_Export(cl_writ(jn), kt, fsolice, info)
    524           IF (jn.eq.2) CALL CLIM_Export(cl_writ(jn), kt, fsolwat, info)
    525           IF (jn.eq.3) CALL CLIM_Export(cl_writ(jn), kt, fnsolice, info)
    526           IF (jn.eq.4) CALL CLIM_Export(cl_writ(jn), kt, fnsolwat, info)
    527           IF (jn.eq.5) CALL CLIM_Export(cl_writ(jn), kt, fnsicedt, info)
     563          IF (jn.eq.8) CALL CLIM_Export(cl_writ(jn), kt, fsolice, info)
     564          IF (jn.eq.9) CALL CLIM_Export(cl_writ(jn), kt, fsolwat, info)
     565         IF (jn.eq.10) CALL CLIM_Export(cl_writ(jn), kt, fnsolice, info)
     566         IF (jn.eq.11) CALL CLIM_Export(cl_writ(jn), kt, fnsolwat, info)
     567         IF (jn.eq.12) CALL CLIM_Export(cl_writ(jn), kt, fnsicedt, info)
    528568c          IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, ictemp, info)
    529           IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, evice, info)
    530           IF (jn.eq.7) CALL CLIM_Export(cl_writ(jn), kt, evwat, info)
    531           IF (jn.eq.8) CALL CLIM_Export(cl_writ(jn), kt, lpre, info)
    532           IF (jn.eq.9) CALL CLIM_Export(cl_writ(jn), kt, spre, info)
    533           IF (jn.eq.10) CALL CLIM_Export(cl_writ(jn),kt,dirunoff, info)
    534           IF (jn.eq.11) CALL CLIM_Export(cl_writ(jn),kt,rivrunoff,info)
    535           IF (jn.eq.12) CALL CLIM_Export(cl_writ(jn),kt,calving,info)
     569          IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, evice, info)
     570          IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, evwat, info)
     571          IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, lpre, info)
     572          IF (jn.eq.16) CALL CLIM_Export(cl_writ(jn), kt, spre, info)
     573          IF (jn.eq.17) CALL CLIM_Export(cl_writ(jn),kt,dirunoff, info)
     574          IF (jn.eq.18) CALL CLIM_Export(cl_writ(jn),kt,rivrunoff,info)
     575          IF (jn.eq.19) CALL CLIM_Export(cl_writ(jn),kt,calving,info)
    536576c$$$          IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, tauxu, info)
    537577c$$$          IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, tauxv, info)
    538578c$$$          IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, tauyv, info)
    539579c$$$          IF (jn.eq.16) CALL CLIM_Export(cl_writ(jn), kt, tauyu, info)
    540           IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, tauxx_u, info)
    541           IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, tauyy_u, info)
    542           IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, tauzz_u, info)
    543           IF (jn.eq.16) CALL CLIM_Export(cl_writ(jn), kt, tauxx_v, info)
    544           IF (jn.eq.17) CALL CLIM_Export(cl_writ(jn), kt, tauyy_v, info)
    545           IF (jn.eq.18) CALL CLIM_Export(cl_writ(jn), kt, tauzz_v, info)
    546          
     580          IF (jn.eq.1) CALL CLIM_Export(cl_writ(jn), kt, tauxx_u, info)
     581          IF (jn.eq.2) CALL CLIM_Export(cl_writ(jn), kt, tauyy_u, info)
     582          IF (jn.eq.3) CALL CLIM_Export(cl_writ(jn), kt, tauzz_u, info)
     583          IF (jn.eq.4) CALL CLIM_Export(cl_writ(jn), kt, tauxx_v, info)
     584          IF (jn.eq.5) CALL CLIM_Export(cl_writ(jn), kt, tauyy_v, info)
     585          IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, tauzz_v, info)
     586c -- LOOP
     587          IF (jn.eq.7) CALL CLIM_Export(cl_writ(jn), kt, windsp, info)
     588c -- LOOP         
    547589            IF (info .NE. CLIM_Ok) THEN
    548590                WRITE (nuout,*) 'STEP : Pb giving ',cl_writ(jn), ':',jn
  • LMDZ4/branches/IPSL-CM4_IPCC_patches/libf/phylmd/param_cou.h

    r524 r589  
    99        PARAMETER(jpmaxfld = 40)        ! Maximum number of fields exchanged
    1010                                        ! between ocean and atmosphere
     11! -- LOOP
    1112        INTEGER jpflda2o1
    12         PARAMETER(jpflda2o1 = 12)         ! Number of fields exchanged from
     13        PARAMETER(jpflda2o1 = 13)        ! Number of fields exchanged from
    1314                                         ! atmosphere to ocean via flx.F
     15! -- LOOP
    1416        INTEGER jpflda2o2
    1517        PARAMETER(jpflda2o2 = 6)         ! Number of fields exchanged from
  • LMDZ4/branches/IPSL-CM4_IPCC_patches/libf/phylmd/write_histhf.h

    r524 r589  
    9898      zx_tmp_fi2d(1 : klon) = fsolsw( 1 : klon, is_ter)
    9999      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
     100      CALL histwrite(nid_hf,"SWnetOR",itau_w,
     101     $     zx_tmp_2d,iim*jjmp1,ndex2d)
     102c
     103      zx_tmp_fi2d(1:klon) = solsw(1:klon)/(1.-albsol(1:klon))
     104      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
    100105      CALL histwrite(nid_hf,"SWdownOR",itau_w,
    101106     $     zx_tmp_2d,iim*jjmp1,ndex2d)
     
    166171
    167172      endif
     173      if (ok_hf) then
     174
     175c   Comprendre comment marche el i=nint(zout/zsto)
     176c
     177c     print*,'ACRITURE HF !!! ACRITURE HF !!! ACRITURE HF !!! '
     178      ndex2d = 0
     179      ndex3d = 0
     180c
     181      zsto = dtime
     182      zout = dtime * ecrit_hf
     183      itau_w = itau_phy + itap
     184c
     185      IF(lev_histhf.GE.1) THEN
     186c
     187c     i = NINT(zout/zsto)
     188c     CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
     189c     CALL histwrite(nid_hf,"phis",i,zx_tmp_2d,iim*jjmp1,ndex2d)
     190c
     191c     i = NINT(zout/zsto)
     192c     CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
     193c     CALL histwrite(nid_hf,"aire",i,zx_tmp_2d,iim*jjmp1,ndex2d)
     194C
     195      CALL gr_fi_ecrit(1, klon,iim,jjmp1, paire_ter, zx_tmp_2d)
     196      CALL histwrite(nid_hf,"aireTER",itau_w,
     197     $      zx_tmp_2d,iim*jjmp1,ndex2d)
     198c
     199      DO i=1, klon
     200       zx_tmp_fi2d(i)=pctsrf(i,is_ter)+pctsrf(i,is_lic)
     201      ENDDO
     202c
     203      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d, zx_tmp_2d)
     204      CALL histwrite(nid_hf,"contfracATM",itau_w,
     205     $      zx_tmp_2d,iim*jjmp1,ndex2d)
     206c
     207      CALL gr_fi_ecrit(1,klon,iim,jjmp1,pctsrf_new(:,is_ter),zx_tmp_2d)
     208      CALL histwrite(nid_hf,"contfracOR",itau_w,
     209     $      zx_tmp_2d,iim*jjmp1,ndex2d)
     210c
     211      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zt2m,zx_tmp_2d)
     212      CALL histwrite(nid_hf,"t2m",itau_w,zx_tmp_2d,iim*jjmp1,
     213     .               ndex2d)
     214c
     215      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zq2m,zx_tmp_2d)
     216      CALL histwrite(nid_hf,"q2m",itau_w,zx_tmp_2d,iim*jjmp1,
     217     .               ndex2d)
     218c
     219      DO i = 1, klon
     220         zx_tmp_fi2d(i) = paprs(i,1)
     221      ENDDO
     222      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
     223      CALL histwrite(nid_hf,"psol",itau_w,zx_tmp_2d,iim*jjmp1,
     224     .               ndex2d)
     225c
     226      DO i = 1, klon
     227         zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
     228      ENDDO
     229      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
     230      CALL histwrite(nid_hf,"rain",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
     231c
     232c ENSEMBLES BEG
     233      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
     234      CALL histwrite(nid_hf,"tsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
     235c
     236      CALL gr_fi_ecrit(1, klon,iim,jjmp1, slp,zx_tmp_2d)
     237      CALL histwrite(nid_hf,"slp",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
     238c
     239      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zu10m,zx_tmp_2d)
     240      CALL histwrite(nid_hf,"u10m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
     241c
     242      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zv10m,zx_tmp_2d)
     243      CALL histwrite(nid_hf,"v10m",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
     244c
     245      DO i=1, klon
     246       zx_tmp_fi2d(i)=SQRT(zu10m(i)*zu10m(i)+zv10m(i)*zv10m(i))
     247      ENDDO
     248      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
     249      CALL histwrite(nid_hf,"wind10m",itau_w,zx_tmp_2d,
     250     $     iim*jjmp1,ndex2d)
     251c
     252      DO k=1, nlevENS
     253      IF(clev(k).EQ."500") THEN
     254      CALL gr_fi_ecrit(1, klon,iim,jjmp1, philev(:,k),zx_tmp_2d)
     255      CALL histwrite(nid_hf,"phi"//clev(k),itau_w,zx_tmp_2d,
     256     $       iim*jjmp1,ndex2d)
     257      ENDIF !clev(k).EQ."500"
     258      ENDDO
     259c
     260      ENDIF !lev_histhf.GE.1
     261c
     262      IF(lev_histhf.GE.2) THEN
     263c
     264      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldt,zx_tmp_2d)
     265      CALL histwrite(nid_hf,"cldt",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
     266c
     267c -- LOOP
     268      zx_tmp_fi2d(1 : klon) = fsolsw( 1 : klon, is_ter)
     269      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
     270      CALL histwrite(nid_hf,"SWnetOR",itau_w,
     271     $     zx_tmp_2d,iim*jjmp1,ndex2d)
     272c
     273      CALL gr_fi_ecrit(1, klon,iim,jjmp1, swdownor , zx_tmp_2d)
     274      CALL histwrite(nid_hf,"SWdownOR",itau_w,
     275     $     zx_tmp_2d,iim*jjmp1,ndex2d)
     276c -- LOOP
     277c
     278      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
     279      CALL histwrite(nid_hf,"LWdownOR",itau_w,zx_tmp_2d,iim*jjmp1,
     280     $     ndex2d)
     281c
     282c
     283      ENDIF !lev_histhf.GE.2
     284c
     285      IF(lev_histhf.GE.3) THEN
     286c
     287      DO k=1, nlevENS
     288c
     289      CALL gr_fi_ecrit(1, klon,iim,jjmp1, tlev(:,k),zx_tmp_2d)
     290      CALL histwrite(nid_hf,"t"//clev(k),itau_w,zx_tmp_2d,
     291     $       iim*jjmp1,ndex2d)
     292c
     293      IF(clev(k).NE."500") THEN !clev(k).NE."500"
     294      CALL gr_fi_ecrit(1, klon,iim,jjmp1, philev(:,k),zx_tmp_2d)
     295      CALL histwrite(nid_hf,"phi"//clev(k),itau_w,zx_tmp_2d,
     296     $       iim*jjmp1,ndex2d)
     297      ENDIF !clev(k).NE."500"
     298c
     299      CALL gr_fi_ecrit(1, klon,iim,jjmp1, qlev(:,k),zx_tmp_2d)
     300      CALL histwrite(nid_hf,"q"//clev(k),itau_w,zx_tmp_2d,
     301     $       iim*jjmp1,ndex2d)
     302c
     303      IF(1.EQ.0) THEN
     304      CALL gr_fi_ecrit(1, klon,iim,jjmp1, rhlev(:,k),zx_tmp_2d)
     305      CALL histwrite(nid_hf,"rh"//clev(k),itau_w,zx_tmp_2d,
     306     $       iim*jjmp1,ndex2d)
     307      ENDIF !1.EQ.0
     308c
     309      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ulev(:,k),zx_tmp_2d)
     310      CALL histwrite(nid_hf,"u"//clev(k),itau_w,zx_tmp_2d,
     311     $       iim*jjmp1,ndex2d)
     312c
     313      CALL gr_fi_ecrit(1, klon,iim,jjmp1, vlev(:,k),zx_tmp_2d)
     314      CALL histwrite(nid_hf,"v"//clev(k),itau_w,zx_tmp_2d,
     315     $       iim*jjmp1,ndex2d)
     316c
     317      ENDDO !nlevENS
     318c
     319      IF(1.EQ.0) THEN
     320      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
     321      CALL histwrite(nid_hf,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
     322c
     323      CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
     324      CALL histwrite(nid_hf,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
     325      ENDIF !(1.EQ.0) THEN
     326c
     327      ENDIF !lev_histhf.GE.3
     328c
     329      IF(lev_histhf.GE.4) THEN
     330c
     331#define histhf3d
     332#ifdef histhf3d
     333#include "write_histhf3d.h"
     334#endif
     335c
     336      ENDIF !lev_histhf.GE.4
     337c
     338      if (ok_sync) then
     339        call histsync(nid_hf)
     340      endif
     341
     342      endif
Note: See TracChangeset for help on using the changeset viewer.