Index: /LMDZ.3.3/branches/rel-LF/libf/phylmd/coefkzmin.F =================================================================== --- /LMDZ.3.3/branches/rel-LF/libf/phylmd/coefkzmin.F (revision 500) +++ /LMDZ.3.3/branches/rel-LF/libf/phylmd/coefkzmin.F (revision 500) @@ -0,0 +1,139 @@ + SUBROUTINE coefkzmin(ngrid,ypaprs,ypplay,yu,yv,yt,yq,ycoefm + . ,km,kn) +c SUBROUTINE coefkzmin(ngrid,zlev,teta,ustar,km,kn) + IMPLICIT NONE + +#include "dimensions.h" +#include "dimphy.h" +#include "YOMCST.h" + +c....................................................................... +c Entrees modifies en attendant une version ou les zlev, et zlay soient +c disponibles. + + REAL ycoefm(klon,klev) + + REAL yu(klon,klev), yv(klon,klev) + REAL yt(klon,klev), yq(klon,klev) + REAL ypaprs(klon,klev+1), ypplay(klon,klev) + REAL yustar(klon) + real yzlay(klon,klev),yzlev(klon,klev+1),yteta(klon,klev) + + integer i + +c....................................................................... +c +c En entree : +c ----------- +c +c zlev : altitude a chaque niveau (interface inferieure de la couche +c de meme indice) +c ustar : u* +c +c teta : temperature potentielle au centre de chaque couche +c (en entree : la valeur au debut du pas de temps) +c +c en sortier : +c ------------ +c +c km : diffusivite turbulente de quantite de mouvement (au bas de chaque +c couche) +c (en sortie : la valeur a la fin du pas de temps) +c kn : diffusivite turbulente des scalaires (au bas de chaque couche) +c (en sortie : la valeur a la fin du pas de temps) +c +c....................................................................... + + real ustar(klon) + real kmin,qmin,pblhmin(klon),coriol(klon) + REAL zlev(klon,klev+1) + REAL teta(klon,klev) + + REAL km(klon,klev+1) + REAL kn(klon,klev+1) + integer l_mix,ngrid + + + integer nlay,nlev + PARAMETER (nlay=klev) + PARAMETER (nlev=klev+1) + + integer ig,k + + real kap + save kap + data kap/0.4/ + + real frif,falpha,fsm + real fl,zzz,zl0,zq2,zn2 + + +c....................................................................... +c en attendant une version ou les zlev, et zlay soient +c disponibles. +c Debut de la partie qui doit etre unclue a terme dans clmain. +c + do i=1,ngrid + yzlay(i,1)=RD*yt(i,1)/(0.5*(ypaprs(i,1)+ypplay(i,1))) + . *(ypaprs(i,1)-ypplay(i,1))/RG + enddo + do k=2,klev + do i=1,ngrid + yzlay(i,k)=yzlay(i,k-1)+RD*0.5*(yt(i,k-1)+yt(i,k)) + s /ypaprs(i,k)*(ypplay(i,k-1)-ypplay(i,k))/RG + enddo + enddo + do k=1,klev + do i=1,ngrid +cATTENTION:on passe la temperature potentielle virt. pour le calcul de K + yteta(i,k)=yt(i,k)*(ypaprs(i,1)/ypplay(i,k))**rkappa + s *(1.+0.61*yq(i,k)) + enddo + enddo + do i=1,ngrid + yzlev(i,1)=0. + yzlev(i,klev+1)=2.*yzlay(i,klev)-yzlay(i,klev-1) + enddo + do k=2,klev + do i=1,ngrid + yzlev(i,k)=0.5*(yzlay(i,k)+yzlay(i,k-1)) + enddo + enddo + + + yustar(:) =SQRT(ycoefm(:,1)*(yu(:,1)*yu(:,1)+yv(:,1)*yv(:,1))) + +c Fin de la partie qui doit etre unclue a terme dans clmain. + +Cette routine est ecrite pour avoir en entree ustar, teta et zlev +c Ici, on a inclut le calcul de ces trois variables dans la routine +c coefkzmin en attendant une nouvelle version de la couche limite +c ou ces variables seront disponibles. + +c Debut de la routine coefkzmin proprement dite. + + ustar=yustar + teta=yteta + zlev=yzlev + + do ig=1,ngrid + coriol(ig)=1.e-4 + pblhmin(ig)=0.07*ustar(ig)/max(abs(coriol(ig)),2.546e-5) + enddo + + do k=2,klev + do ig=1,ngrid + if (teta(ig,2).gt.teta(ig,1)) then + qmin=ustar(ig)*(max(1.-zlev(ig,k)/pblhmin(ig),0.))**2 + kmin=kap*zlev(ig,k)*qmin + else + kmin=0. ! kmin n'est utilise que pour les SL stables. + endif + kn(ig,k)=kmin + km(ig,k)=kmin + enddo + enddo + + + return + end Index: /LMDZ.3.3/branches/rel-LF/libf/phylmd/haut2bas.F =================================================================== --- /LMDZ.3.3/branches/rel-LF/libf/phylmd/haut2bas.F (revision 500) +++ /LMDZ.3.3/branches/rel-LF/libf/phylmd/haut2bas.F (revision 500) @@ -0,0 +1,16 @@ + SUBROUTINE haut2bas(klon, klev, varB2H, varH2B) + IMPLICIT NONE +c + INTEGER klon, klev + REAL varB2H(klon, klev), varH2B(klon, klev) + INTEGER i, k, kinv +c + DO k=1,klev + kinv=klev-k+1 + DO i=1,klon + varH2B(i,k)=varB2H(i,kinv) + ENDDO + ENDDO +c + RETURN + END Index: /LMDZ.3.3/branches/rel-LF/libf/phylmd/ini_histISCCP.h =================================================================== --- /LMDZ.3.3/branches/rel-LF/libf/phylmd/ini_histISCCP.h (revision 500) +++ /LMDZ.3.3/branches/rel-LF/libf/phylmd/ini_histISCCP.h (revision 500) @@ -0,0 +1,71 @@ + IF (ok_isccp) THEN +c + IF (region.EQ.'3d') THEN !region +c pour les champs instantannes, il faut mettre la meme valeur pour +c zout et zsto. +c dtime est passe par ailleurs a histbeg +c zsto = frequence de stockage des champs +c zout = frequence d'ecriture des champs + zsto = dtime +c +c ecriture 8 fois par jour +c zout = dtime * REAL(NINT(86400./dtime*ecrit_isccp)) +c ecriture toutes les 2h (12 fois par jour) +c zout = dtime * 4. +c ecriture toutes les 1/h (48 fois par jour) +c zout = dtime +c +c ecriture mensuelle + zout = dtime * ecrit_mth +c + ELSE IF (region.EQ.'1d') THEN !region + zsto = dtime + zout = dtime *4. +c zout = dtime + ENDIF +c + print*,'ISCCP zout,zsto=',zout,zsto +c +c PRINT*, 'La frequence de sortie ISCCP est de ', ecrit_isccp +c + idayref = day_ref + CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian) + write(*,*)'ISCCP ', itau_phy, zjulian +c +c +c definition coordonnees lon,lat en globale +c + CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon) + DO i = 1, iim + zx_lon(i,1) = rlon(i+1) + zx_lon(i,jjmp1) = rlon(i+1) + ENDDO + + CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat) +c + CALL histbeg("histISCCP.nc", iim,zx_lon(:,1),jjmp1,zx_lat(1,:), + . imin_debut,nbpti, + . jmin_debut,nbptj, + . itau_phy, zjulian, dtime, + . nhori, nid_isccp) +c + CALL histvert(nid_isccp, "cldtopres","Cloud Top Pressure","mb", + . lmaxm1, cldtopres, nvert,'down') +c +c variables a ecrire +c + DO k=1, kmaxm1 + CALL histdef(nid_isccp, "cldISCCP_"//taulev(k), + . "LMDZ ISCCP cld", "%", + . iim, jjmp1,nhori,lmaxm1,1,lmaxm1,nvert,32, + . "ave(X)", zsto,zout) + ENDDO +c + CALL histdef(nid_isccp, "nsunlit", + . "Nb of calls with sunlit ", "%", + . iim, jjmp1,nhori,1,1,1,-99,32, + . "ave(X)", zsto,zout) +c + CALL histend(nid_isccp) +c + ENDIF ! ok_isccp Index: /LMDZ.3.3/branches/rel-LF/libf/phylmd/ini_histREGDYN.h =================================================================== --- /LMDZ.3.3/branches/rel-LF/libf/phylmd/ini_histREGDYN.h (revision 500) +++ /LMDZ.3.3/branches/rel-LF/libf/phylmd/ini_histREGDYN.h (revision 500) @@ -0,0 +1,117 @@ + + IF (ok_regdyn) THEN +c + PRINT*, 'La frequence de sortie REGDYN est de ', ecrit_mth +c PRINT*, 'La frequence de sortie REGDYN est de ', ecrit_regdyn +cIM cf. LF + idayref = day_ref + CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian) + +cccIM CALL ymds2ju(anne_ini, 1, 1, 0.0, zjulian) +c CALL ymds2ju(annee_ref, 1, 1, 0.0, zjulian) +c zjulian = zjulian + day_ini +c + +c axe vertical pour les differents niveaux des histogrammes + DO iw=1, iwmax + zx_o500(iw)=wmin+(iw-1./2.)*pas_w + ENDDO + + CALL histbeg("histREGDYN", kmaxm1,zx_tau, lmaxm1,zx_pc, + . 1,kmaxm1,1,lmaxm1, itau_phy, zjulian, dtime, + . nhoriRD, nid_regdyn) + + CALL histvert(nid_regdyn, "omeganivs", "Omega levels", + . "mb/day", + . iwmax, zx_o500, komega) + +c pour les champs instantannes, il faut mettre la meme valeur pour +c zout et tsto. +c dtime est passe par ailleurs a histbeg + +c zout = dtime * REAL(NINT(86400./dtime*ecrit_regdyn)) +c zsto = zout +c print*,'zout,zsto=',zout,zsto +c ecriture mensuelle +c + zsto = dtime + zout = dtime * ecrit_mth +c zout = dtime * REAL(NINT(86400./dtime*ecrit_regdyn)) + +c +c Champs 3D: +c +c TROP + CALL histdef(nid_regdyn, "hw1", "Tropics Histogram ", "%", + & kmaxm1,lmaxm1,nhoriRD, iwmax,1,iwmax, komega, 32, + & "ave(X)", zsto,zout) + + CALL histdef(nid_regdyn, "nh1", "Nb of pixels Tropics Histo", + & "%",kmaxm1,lmaxm1,nhoriRD, iwmax,1,iwmax, komega, + & 32,"ave(X)", zsto,zout) +c + + CALL histdef(nid_regdyn, "nht1","Total Nb pixels Tropics Histo" + & ,"%",kmaxm1,lmaxm1,nhoriRD, iwmax,1,iwmax, komega, + & 32,"ave(X)", zsto,zout) +c +c PAN + CALL histdef(nid_regdyn, "hw2", "North Pacific Histogram", "%", + & kmaxm1,lmaxm1,nhoriRD, iwmax,1,iwmax, komega, 32, + & "ave(X)", zsto,zout) + + CALL histdef(nid_regdyn, "nh2", "Nb of pixels North Pacific", + & "%",kmaxm1,lmaxm1,nhoriRD, iwmax,1,iwmax, komega, + & 32,"ave(X)", zsto,zout) +c + + CALL histdef(nid_regdyn, "nht2","Total Nb pixels North Pacific + & Histo" + & ,"%",kmaxm1,lmaxm1,nhoriRD, iwmax,1,iwmax, komega, + & 32,"ave(X)", zsto,zout) +c CAL + CALL histdef(nid_regdyn, "hw3", "California Histogram", "%", + & kmaxm1,lmaxm1,nhoriRD, iwmax,1,iwmax, komega, 32, + & "ave(X)", zsto,zout) + + CALL histdef(nid_regdyn, "nh3", "Nb of pixels California + & Histo", + & "%",kmaxm1,lmaxm1,nhoriRD, iwmax,1,iwmax, komega, + & 32,"ave(X)", zsto,zout) +c + + CALL histdef(nid_regdyn, "nht3","Total Nb pixels California + & Histo" + & ,"%",kmaxm1,lmaxm1,nhoriRD, iwmax,1,iwmax, komega, + & 32,"ave(X)", zsto,zout) +c HAW + CALL histdef(nid_regdyn, "hw4", "Hawai Histogram", "%", + & kmaxm1,lmaxm1,nhoriRD, iwmax,1,iwmax, komega, 32, + & "ave(X)", zsto,zout) + + CALL histdef(nid_regdyn, "nh4", "Nb of pixels Hawai Histo", + & "%",kmaxm1,lmaxm1,nhoriRD, iwmax,1,iwmax, komega, + & 32,"ave(X)", zsto,zout) +c + + CALL histdef(nid_regdyn, "nht4","Total Nb pixels Hawai Histo" + & ,"%",kmaxm1,lmaxm1,nhoriRD, iwmax,1,iwmax, komega, + & 32,"ave(X)", zsto,zout) +c WAP + CALL histdef(nid_regdyn, "hw5", "Warm Pool Histogram", "%", + & kmaxm1,lmaxm1,nhoriRD, iwmax,1,iwmax, komega, 32, + & "ave(X)", zsto,zout) + + CALL histdef(nid_regdyn, "nh5", "Nb of pixels Warm Pool Histo", + & "%",kmaxm1,lmaxm1,nhoriRD, iwmax,1,iwmax, komega, + & 32,"ave(X)", zsto,zout) +c + + CALL histdef(nid_regdyn, "nht5","Total Nb pixels Warm Pool + & Histo" + & ,"%",kmaxm1,lmaxm1,nhoriRD, iwmax,1,iwmax, komega, + & 32,"ave(X)", zsto,zout) +c + CALL histend(nid_regdyn) + + endif ! ok_regdyn Index: /LMDZ.3.3/branches/rel-LF/libf/phylmd/ini_histmthNMC.h =================================================================== --- /LMDZ.3.3/branches/rel-LF/libf/phylmd/ini_histmthNMC.h (revision 500) +++ /LMDZ.3.3/branches/rel-LF/libf/phylmd/ini_histmthNMC.h (revision 500) @@ -0,0 +1,218 @@ +c IF (ok_mensuelNMC) THEN + IF (ok_mensuel) THEN +c + IF(region.EQ.'3d') THEN + zsto = dtime + zout = dtime * ecrit_mth + ELSEIF(region.EQ.'1d') THEN + zsto = dtime +c zout = dtime + zout = dtime *4. + ENDIF +c + idayref = day_ref + CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian) +c + CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon) + DO i = 1, iim + zx_lon(i,1) = rlon(i+1) + zx_lon(i,jjmp1) = rlon(i+1) + ENDDO + DO ll=1,klev + znivsig(ll)=float(ll) + ENDDO + CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat) + CALL histbeg("histNMC.nc", iim,zx_lon(:,1), jjmp1,zx_lat(1,:), +c071103 +c . 1,iim,1,jjmp1, + . imin_debut,nbpti, + . jmin_debut,nbptj, +c071103 + . itau_phy, zjulian, dtime, + . nhori, nid_nmc) + write(*,*)'Mensuel NMC ', itau_phy, zjulian + CALL histvert(nid_nmc, "presnivs", "Vertical levels", "mb", + . klev, presnivs, nvert) +c call histvert(nid_nmc, 'sig_s', 'Niveaux sigma','-', +c . klev, znivsig, nvert) +c +c Champs 2D: + +c Champs interpolles sur des niveaux de pression du NMC + CALL histdef(nid_nmc, "u1000", + . "Zonal wind 1000mb", + . "m/s", + . iim,jjmp1,nhori, 1,1,1, -99, 32, + . "ave(X)", zsto,zout) + + CALL histdef(nid_nmc, "v1000", + . "Meridional wind 1000mb", "m/s", + . iim,jjmp1,nhori, 1,1,1, -99, 32, + . "ave(X)", zsto,zout) + + CALL histdef(nid_nmc, "u925", "Zonal wind 925mb", + . "m/s", + . iim,jjmp1,nhori, 1,1,1, -99, 32, + . "ave(X)", zsto,zout) + + CALL histdef(nid_nmc, "v925", "Meridional wind 925mb", + . "m/s", + . iim,jjmp1,nhori, 1,1,1, -99, 32, + . "ave(X)", zsto,zout) + + CALL histdef(nid_nmc, "u850", "Zonal wind 850mb", + . "m/s", + . iim,jjmp1,nhori, 1,1,1, -99, 32, + . "ave(X)", zsto,zout) + + CALL histdef(nid_nmc, "v850", "Meridional wind 850mb", + . "m/s", + . iim,jjmp1,nhori, 1,1,1, -99, 32, + . "ave(X)", zsto,zout) +c + CALL histdef(nid_nmc, "u700", "Zonal wind 700mb", + . "m/s", + . iim,jjmp1,nhori, 1,1,1, -99, 32, + . "ave(X)", zsto,zout) + + CALL histdef(nid_nmc, "v700", "Meridional wind 700mb", + . "m/s", + . iim,jjmp1,nhori, 1,1,1, -99, 32, + . "ave(X)", zsto,zout) +c + CALL histdef(nid_nmc, "u600", "Zonal wind 600mb", + . "m/s", + . iim,jjmp1,nhori, 1,1,1, -99, 32, + . "ave(X)", zsto,zout) + + CALL histdef(nid_nmc, "v600", "Meridional wind 600mb", + . "m/s", + . iim,jjmp1,nhori, 1,1,1, -99, 32, + . "ave(X)", zsto,zout) +c + CALL histdef(nid_nmc, "u500", "Zonal wind 500mb", + . "m/s", + . iim,jjmp1,nhori, 1,1,1, -99, 32, + . "ave(X)", zsto,zout) + + CALL histdef(nid_nmc, "v500", "Meridional wind 500mb", + . "m/s", + . iim,jjmp1,nhori, 1,1,1, -99, 32, + . "ave(X)", zsto,zout) +c + CALL histdef(nid_nmc, "u400", "Zonal wind 400mb", + . "m/s", + . iim,jjmp1,nhori, 1,1,1, -99, 32, + . "ave(X)", zsto,zout) + + CALL histdef(nid_nmc, "v400", "Meridional wind 400mb", + . "m/s", + . iim,jjmp1,nhori, 1,1,1, -99, 32, + . "ave(X)", zsto,zout) +c + CALL histdef(nid_nmc, "u300", "Zonal wind 300mb", + . "m/s", + . iim,jjmp1,nhori, 1,1,1, -99, 32, + . "ave(X)", zsto,zout) + + CALL histdef(nid_nmc, "v300", "Meridional wind 300mb", + . "m/s", + . iim,jjmp1,nhori, 1,1,1, -99, 32, + . "ave(X)", zsto,zout) +c + CALL histdef(nid_nmc, "u250", "Zonal wind 250mb", + . "m/s", + . iim,jjmp1,nhori, 1,1,1, -99, 32, + . "ave(X)", zsto,zout) + + CALL histdef(nid_nmc, "v250", "Meridional wind 250mb", + . "m/s", + . iim,jjmp1,nhori, 1,1,1, -99, 32, + . "ave(X)", zsto,zout) +c + CALL histdef(nid_nmc, "u200", "Zonal wind 200mb", + . "m/s", + . iim,jjmp1,nhori, 1,1,1, -99, 32, + . "ave(X)", zsto,zout) + + CALL histdef(nid_nmc, "v200", "Meridional wind 200mb", + . "m/s", + . iim,jjmp1,nhori, 1,1,1, -99, 32, + . "ave(X)", zsto,zout) +c + CALL histdef(nid_nmc, "u150", "Zonal wind 150mb", + . "m/s", + . iim,jjmp1,nhori, 1,1,1, -99, 32, + . "ave(X)", zsto,zout) + + CALL histdef(nid_nmc, "v150", "Meridional wind 150mb", + . "m/s", + . iim,jjmp1,nhori, 1,1,1, -99, 32, + . "ave(X)", zsto,zout) +c + CALL histdef(nid_nmc, "u100", "Zonal wind 100mb", + . "m/s", + . iim,jjmp1,nhori, 1,1,1, -99, 32, + . "ave(X)", zsto,zout) + + CALL histdef(nid_nmc, "v100", "Meridional wind 100mb", + . "m/s", + . iim,jjmp1,nhori, 1,1,1, -99, 32, + . "ave(X)", zsto,zout) +c + CALL histdef(nid_nmc, "u70", "Zonal wind 70mb", + . "m/s", + . iim,jjmp1,nhori, 1,1,1, -99, 32, + . "ave(X)", zsto,zout) + + CALL histdef(nid_nmc, "v70", "Meridional wind 70mb", + . "m/s", + . iim,jjmp1,nhori, 1,1,1, -99, 32, + . "ave(X)", zsto,zout) +c + CALL histdef(nid_nmc, "u50", "Zonal wind 50mb", + . "m/s", + . iim,jjmp1,nhori, 1,1,1, -99, 32, + . "ave(X)", zsto,zout) + + CALL histdef(nid_nmc, "v50", "Meridional wind 50mb", + . "m/s", + . iim,jjmp1,nhori, 1,1,1, -99, 32, + . "ave(X)", zsto,zout) +c + CALL histdef(nid_nmc, "u30", "Zonal wind 30mb", + . "m/s", + . iim,jjmp1,nhori, 1,1,1, -99, 32, + . "ave(X)", zsto,zout) + + CALL histdef(nid_nmc, "v30", "Meridional wind 30mb", + . "m/s", + . iim,jjmp1,nhori, 1,1,1, -99, 32, + . "ave(X)", zsto,zout) +c + CALL histdef(nid_nmc, "u20", "Zonal wind 20mb", + . "m/s", + . iim,jjmp1,nhori, 1,1,1, -99, 32, + . "ave(X)", zsto,zout) + + CALL histdef(nid_nmc, "v20", "Meridional wind 20mb", + . "m/s", + . iim,jjmp1,nhori, 1,1,1, -99, 32, + . "ave(X)", zsto,zout) +c + CALL histdef(nid_nmc, "u10", "Zonal wind 10mb", + . "m/s", + . iim,jjmp1,nhori, 1,1,1, -99, 32, + . "ave(X)", zsto,zout) + + CALL histdef(nid_nmc, "v10", "Meridional wind 10mb", + . "m/s", + . iim,jjmp1,nhori, 1,1,1, -99, 32, + . "ave(X)", zsto,zout) +c + CALL histend(nid_nmc) +c +c ndex2d = 0 +c + ENDIF ! fin de test sur ok_mensuel + Index: /LMDZ.3.3/branches/rel-LF/libf/phylmd/oasis.psmile =================================================================== --- /LMDZ.3.3/branches/rel-LF/libf/phylmd/oasis.psmile (revision 500) +++ /LMDZ.3.3/branches/rel-LF/libf/phylmd/oasis.psmile (revision 500) @@ -0,0 +1,429 @@ +! $Header$ + + MODULE oasis + +! Module contenant les routines pour l'initialisation du couplage, la +! lecture et l'ecriture des champs venant/transmis au coupleur +! + + IMPLICIT none + + PRIVATE + PUBLIC :: inicma, fromcpl, intocpl + + INTERFACE inicma + module procedure inicma + END INTERFACE + +#include "param_cou.h" + + integer, dimension(jpfldo2a), save :: in_var_id + integer, dimension(jpflda2o1+jpflda2o2), save :: il_out_var_id + CHARACTER (len=8), dimension(jpmaxfld), save :: cl_writ, cl_read + CHARACTER (len=8), dimension(jpmaxfld), save :: cl_f_writ, cl_f_read + +CONTAINS + +!**** +! +!**** *INICMA* - Initialize coupled mode communication for atmosphere +! and exchange some initial information with Oasis +! +! Rewrite to take the PRISM/psmile library into account +! LF 09/2003 +! +! Input: +! ----- +! im, jm: size of grid passed between gcm and coupler +! +! ----------------------------------------------------------- +! + SUBROUTINE inicma(im, jm) + + use mod_prism_proto + use mod_prism_def_partition_proto + + implicit none + +#include "param_cou.h" + +! +! parameters +! + integer :: im, jm +! +! local variables +! +! integers +! + integer :: comp_id + integer :: ierror + integer :: il_part_id + integer, dimension(:), allocatable :: ig_paral + integer, dimension(jpfldo2a) :: in_var_id + integer, dimension(jpflda2o1+jpflda2o2) :: il_out_var_id + integer, dimension(2) :: il_var_nodims + integer, dimension(4) :: il_var_actual_shape + integer :: il_var_type + integer :: nuout = 6 + integer :: jf +! characters +! + character (len = 6) :: clmodnam + character (len = 20),save :: modname = 'inicma' + character (len = 80) :: abort_message + +! +! ----------------------------------------------------------- +! +!* 1. Initializations +! --------------- +! + WRITE(nuout,*) ' ' + WRITE(nuout,*) ' ' + WRITE(nuout,*) ' ROUTINE INICMA' + WRITE(nuout,*) ' **************' + WRITE(nuout,*) ' ' + WRITE(nuout,*) ' ' +! +! Define the model name +! + clmodnam = 'lmdz.x' ! as in $NBMODEL in Cpl/Nam/namcouple.tmp +! +! +! Here we go: psmile initialisation +! + call prism_init_comp_proto (comp_id, clmodnam, ierror) + + IF (ierror .ne. PRISM_Ok) THEN + abort_message=' Probleme init dans prism_init_comp ' + call abort_gcm(modname,abort_message,1) + ELSE + WRITE(nuout,*) 'inicma : init psmile ok ' + ENDIF + +! +! and domain decomposition +! +! monoproc case +! + allocate(ig_paral(3)) + ig_paral(1) = 0 + ig_paral(2) = 0 + ig_paral(3) = im * jm + + call prism_def_partition_proto (il_part_id, ig_paral, ierror) + deallocate(ig_paral) +! + IF (ierror .ne. PRISM_Ok) THEN + abort_message=' Probleme dans prism_def_partition ' + call abort_gcm(modname,abort_message,1) + ELSE + WRITE(nuout,*) 'inicma : decomposition domaine psmile ok ' + ENDIF + +! +! Field Declarations +! +! Define symbolic name for fields exchanged from atmos to coupler, +! must be the same as (1) of the field definition in namcouple: +! + cl_writ(1)='COSHFICE' + cl_writ(2)='COSHFOCE' + cl_writ(3)='CONSFICE' + cl_writ(4)='CONSFOCE' + cl_writ(5)='CODFLXDT' + cl_writ(6)='COTFSICE' + cl_writ(7)='COTFSOCE' + cl_writ(8)='COTOLPSU' + cl_writ(9)='COTOSPSU' + cl_writ(10)='CORUNCOA' + cl_writ(11)='CORIVFLU' + cl_writ(12)='COCALVIN' + cl_writ(13)='COTAUXXU' + cl_writ(14)='COTAUYYU' + cl_writ(15)='COTAUZZU' + cl_writ(16)='COTAUXXV' + cl_writ(17)='COTAUYYV' + cl_writ(18)='COTAUZZV' +! +! Define symbolic name for fields exchanged from coupler to atmosphere, +! must be the same as (2) of the field definition in namcouple: +! + cl_read(1)='SISUTESW' + cl_read(2)='SIICECOV' + cl_read(3)='SIICEALW' + cl_read(4)='SIICTEMW' + + il_var_nodims(1) = 2 + il_var_nodims(2) = 1 + + il_var_actual_shape(1) = 1 + il_var_actual_shape(2) = im + il_var_actual_shape(3) = 1 + il_var_actual_shape(4) = jm + + il_var_type = PRISM_Real +! +! Oceanic Fields +! + DO jf=1, jpfldo2a + call prism_def_var_proto(in_var_id(jf), cl_read(jf), il_part_id, & +& il_var_nodims, PRISM_In, il_var_actual_shape, il_var_type, & +& ierror) + IF (ierror .ne. PRISM_Ok) THEN + abort_message=' Probleme init dans prism_def_var_proto ' + call abort_gcm(modname,abort_message,1) + ENDIF + END DO +! +! Atmospheric Fields +! + DO jf=1, jpflda2o1+jpflda2o2 + call prism_def_var_proto(il_out_var_id(jf), cl_writ(jf), il_part_id, & +& il_var_nodims, PRISM_Out, il_var_actual_shape, il_var_type, & +& ierror) + IF (ierror .ne. PRISM_Ok) THEN + abort_message=' Probleme init dans prism_def_var_proto ' + call abort_gcm(modname,abort_message,1) + ENDIF + END DO +! +! End +! + call prism_enddef_proto(ierror) + IF (ierror .ne. PRISM_Ok) THEN + abort_message=' Probleme init dans prism_ endef_proto' + call abort_gcm(modname,abort_message,1) + ELSE + WRITE(nuout,*) 'inicma : endef psmile ok ' + ENDIF + + END SUBROUTINE inicma + + SUBROUTINE fromcpl(kt, im, jm, sst, gla, tice, albedo) +! ====================================================================== +! L. Fairhead (09/2003) adapted From L.Z.X Li: this subroutine reads the SST +! and Sea-Ice provided by the coupler. Adaptation to psmile library +!====================================================================== + + use mod_prism_proto + use mod_prism_get_proto + + IMPLICIT none + +! +! parametres +! + integer :: im, jm, kt + real, dimension(im, jm) :: sst ! sea-surface-temperature + real, dimension(im, jm) :: gla ! sea-ice + real, dimension(im, jm) :: tice ! temp glace + real, dimension(im, jm) :: albedo ! albedo glace +! +! local variables +! + integer :: nuout = 6 ! listing output unit + integer :: ierror + character (len = 20),save :: modname = 'fromcpl' + character (len = 80) :: abort_message +! +#include "param_cou.h" +! +! + WRITE (nuout,*) ' ' + WRITE (nuout,*) 'Fromcpl: Reading fields from CPL, kt=',kt + WRITE (nuout,*) ' ' + CALL flush (nuout) + + call prism_get_proto(in_var_id(1), kt, sst, ierror) + IF (ierror .ne. PRISM_Ok) THEN + WRITE (nuout,*) cl_read(1), kt + abort_message=' Probleme dans prism_get_proto ' + call abort_gcm(modname,abort_message,1) + endif + call prism_get_proto(in_var_id(2), kt, gla, ierror) + IF (ierror .ne. PRISM_Ok) THEN + WRITE (nuout,*) cl_read(2), kt + abort_message=' Probleme dans prism_get_proto ' + call abort_gcm(modname,abort_message,1) + endif + call prism_get_proto(in_var_id(3), kt, albedo, ierror) + IF (ierror .ne. PRISM_Ok) THEN + WRITE (nuout,*) cl_read(3), kt + abort_message=' Probleme dans prism_get_proto ' + call abort_gcm(modname,abort_message,1) + endif + call prism_get_proto(in_var_id(4), kt, tice, ierror) + IF (ierror .ne. PRISM_Ok) THEN + WRITE (nuout,*) cl_read(4), kt + abort_message=' Probleme dans prism_get_proto ' + call abort_gcm(modname,abort_message,1) + endif + +! + RETURN + END SUBROUTINE fromcpl + + SUBROUTINE intocpl(kt, im, jm, fsolice, fsolwat, fnsolice, fnsolwat, & + & fnsicedt, evice, evwat, lpre, spre, dirunoff, rivrunoff, & + & calving, tauxx_u, tauyy_u, tauzz_u, tauxx_v, tauyy_v, tauzz_v & + & , last) +! ====================================================================== +! L. Fairhead (09/2003) adapted From L.Z.X Li: this subroutine provides the +! atmospheric coupling fields to the coupler with the psmile library. +! IF last time step, writes output fields to binary files. +! ====================================================================== + + use mod_prism_proto + use mod_prism_put_proto + + IMPLICIT NONE + +! +! parametres +! + integer :: kt, im, jm + real, dimension(im, jm) :: fsolice, fsolwat, fnsolwat, fnsolice + real, dimension(im, jm) :: fnsicedt, evice, evwat, lpre, spre + real, dimension(im, jm) :: dirunoff, rivrunoff, calving + real, dimension(im, jm) :: tauxx_u, tauxx_v, tauyy_u + real, dimension(im, jm) :: tauyy_v, tauzz_u, tauzz_v + logical :: last +! +! local +! + integer, parameter :: nuout = 6 + integer :: ierror + character (len = 20),save :: modname = 'intocpl' + character (len = 80) :: abort_message +! +! + WRITE(nuout,*) ' ' + WRITE(nuout,*) 'Intocpl: sending fields to CPL, kt= ', kt + WRITE(nuout,*) 'last ', last + WRITE(nuout,*) + + call prism_put_proto(il_out_var_id(1), kt, fsolice, ierror) + IF (ierror .ne. PRISM_Ok) THEN + WRITE (nuout,*) cl_writ(1), kt + abort_message=' Probleme dans prism_put_proto ' + call abort_gcm(modname,abort_message,1) + endif + call prism_put_proto(il_out_var_id(2), kt, fsolwat, ierror) + IF (ierror .ne. PRISM_Ok) THEN + WRITE (nuout,*) cl_writ(2), kt + abort_message=' Probleme dans prism_put_proto ' + call abort_gcm(modname,abort_message,1) + endif + call prism_put_proto(il_out_var_id(3), kt, fnsolice, ierror) + IF (ierror .ne. PRISM_Ok) THEN + WRITE (nuout,*) cl_writ(3), kt + abort_message=' Probleme dans prism_put_proto ' + call abort_gcm(modname,abort_message,1) + endif + call prism_put_proto(il_out_var_id(4), kt, fnsolwat, ierror) + IF (ierror .ne. PRISM_Ok) THEN + WRITE (nuout,*) cl_writ(4), kt + abort_message=' Probleme dans prism_put_proto ' + call abort_gcm(modname,abort_message,1) + endif + call prism_put_proto(il_out_var_id(5), kt, fnsicedt, ierror) + IF (ierror .ne. PRISM_Ok) THEN + WRITE (nuout,*) cl_writ(5), kt + abort_message=' Probleme dans prism_put_proto ' + call abort_gcm(modname,abort_message,1) + endif + call prism_put_proto(il_out_var_id(6), kt, evice, ierror) + IF (ierror .ne. PRISM_Ok) THEN + WRITE (nuout,*) cl_writ(6), kt + abort_message=' Probleme dans prism_put_proto ' + call abort_gcm(modname,abort_message,1) + endif + call prism_put_proto(il_out_var_id(7), kt, evwat, ierror) + IF (ierror .ne. PRISM_Ok) THEN + WRITE (nuout,*) cl_writ(7), kt + abort_message=' Probleme dans prism_put_proto ' + call abort_gcm(modname,abort_message,1) + endif + call prism_put_proto(il_out_var_id(8), kt, lpre, ierror) + IF (ierror .ne. PRISM_Ok) THEN + WRITE (nuout,*) cl_writ(8), kt + abort_message=' Probleme dans prism_put_proto ' + call abort_gcm(modname,abort_message,1) + endif + call prism_put_proto(il_out_var_id(9), kt, spre, ierror) + IF (ierror .ne. PRISM_Ok) THEN + WRITE (nuout,*) cl_writ(9), kt + abort_message=' Probleme dans prism_put_proto ' + call abort_gcm(modname,abort_message,1) + endif + call prism_put_proto(il_out_var_id(10), kt, dirunoff, ierror) + IF (ierror .ne. PRISM_Ok) THEN + WRITE (nuout,*) cl_writ(10), kt + abort_message=' Probleme dans prism_put_proto ' + call abort_gcm(modname,abort_message,1) + endif + call prism_put_proto(il_out_var_id(11), kt, rivrunoff, ierror) + IF (ierror .ne. PRISM_Ok) THEN + WRITE (nuout,*) cl_writ(11), kt + abort_message=' Probleme dans prism_put_proto ' + call abort_gcm(modname,abort_message,1) + endif + call prism_put_proto(il_out_var_id(12), kt, calving, ierror) + IF (ierror .ne. PRISM_Ok) THEN + WRITE (nuout,*) cl_writ(12), kt + abort_message=' Probleme dans prism_put_proto ' + call abort_gcm(modname,abort_message,1) + endif + call prism_put_proto(il_out_var_id(13), kt, tauxx_u, ierror) + IF (ierror .ne. PRISM_Ok) THEN + WRITE (nuout,*) cl_writ(13), kt + abort_message=' Probleme dans prism_put_proto ' + call abort_gcm(modname,abort_message,1) + endif + call prism_put_proto(il_out_var_id(14), kt, tauyy_u, ierror) + IF (ierror .ne. PRISM_Ok) THEN + WRITE (nuout,*) cl_writ(14), kt + abort_message=' Probleme dans prism_put_proto ' + call abort_gcm(modname,abort_message,1) + endif + call prism_put_proto(il_out_var_id(15), kt, tauzz_u, ierror) + IF (ierror .ne. PRISM_Ok) THEN + WRITE (nuout,*) cl_writ(15), kt + abort_message=' Probleme dans prism_put_proto ' + call abort_gcm(modname,abort_message,1) + endif + call prism_put_proto(il_out_var_id(16), kt, tauxx_v, ierror) + IF (ierror .ne. PRISM_Ok) THEN + WRITE (nuout,*) cl_writ(16), kt + abort_message=' Probleme dans prism_put_proto ' + call abort_gcm(modname,abort_message,1) + endif + call prism_put_proto(il_out_var_id(17), kt, tauyy_v, ierror) + IF (ierror .ne. PRISM_Ok) THEN + WRITE (nuout,*) cl_writ(17), kt + abort_message=' Probleme dans prism_put_proto ' + call abort_gcm(modname,abort_message,1) + endif + call prism_put_proto(il_out_var_id(18), kt, tauzz_v, ierror) + IF (ierror .ne. PRISM_Ok) THEN + WRITE (nuout,*) cl_writ(18), kt + abort_message=' Probleme dans prism_put_proto ' + call abort_gcm(modname,abort_message,1) + endif + + if (last) then + call prism_terminate_proto(ierror) + IF (ierror .ne. PRISM_Ok) THEN + WRITE (nuout,*) cl_writ(18), kt + abort_message=' Probleme dans prism_terminate_proto ' + call abort_gcm(modname,abort_message,1) + endif + endif + + + RETURN + END SUBROUTINE intocpl + + END MODULE oasis Index: /LMDZ.3.3/branches/rel-LF/libf/phylmd/write_histISCCP.h =================================================================== --- /LMDZ.3.3/branches/rel-LF/libf/phylmd/write_histISCCP.h (revision 500) +++ /LMDZ.3.3/branches/rel-LF/libf/phylmd/write_histISCCP.h (revision 500) @@ -0,0 +1,29 @@ + IF (ok_isccp) THEN +c + ndex0d = 0 + ndex1d = 0 + ndex2d = 0 + ndex3d = 0 +c + itau_w = itau_phy + itap +c + DO k=1,kmaxm1 + zx_tmp_fi3d(1:klon, 1:lmaxm1)=fq_isccp(1:klon,k,1:lmaxm1)*100. + CALL gr_fi_ecrit(lmaxm1,klon,iim,jjmp1,zx_tmp_fi3d, + . zx_tmp_3d) +c +cIM: champ 3d : (lon,lat,pres) pour un tau fixe +c + CALL histwrite(nid_isccp,"cldISCCP_"//taulev(k),itau_w, + . zx_tmp_3d,iim*jjmp1*lmaxm1,ndex3d) + ENDDO !k +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1,nbsunlit(1,:),zx_tmp_2d) + CALL histwrite(nid_isccp,"nsunlit",itau_w, + . zx_tmp_2d,iim*jjmp1,ndex2d) +c + if (ok_sync) then + call histsync(nid_isccp) + endif + + ENDIF !ok_isccp Index: /LMDZ.3.3/branches/rel-LF/libf/phylmd/write_histREGDYN.h =================================================================== --- /LMDZ.3.3/branches/rel-LF/libf/phylmd/write_histREGDYN.h (revision 500) +++ /LMDZ.3.3/branches/rel-LF/libf/phylmd/write_histREGDYN.h (revision 500) @@ -0,0 +1,85 @@ + if (ok_regdyn) then + +c Comprendre comment marche el i=nint(zout/zsto) +c + ndex2d = 0 + ndex3d = 0 +c +c itap = 0 +c zsto = dtime * REAL(NINT(86400./dtime*ecrit_regdyn)) +c zout = dtime * ecrit_mth + +c zsto = dtime +c zout = dtime * ecrit_mth +c zsto = dtime * REAL(NINT(86400./dtime*ecrit_regdyn)) + itau_w = itau_phy + itap +c +c i = NINT(zout/zsto) +c CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d) +c CALL histwrite(nid_regdyn,"phis",i,zx_tmp_2d,iim*jjmp1,ndex2d) +c +c i = NINT(zout/zsto) +c CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d) +c CALL histwrite(nid_regdyn,"aire",i,zx_tmp_2d,iim*jjmp1,ndex2d) +C +c CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d) +c CALL histwrite(nid_regdyn,"tsol",itap,zx_tmp_2d,iim*jjmp1,ndex2d) +c +c 8 or day CALL histwrite(nid_regdyn,"histoW",itap,histoW, +c +c CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d) + +c +c CALL gr_fi_ecrit(iwmax,kmaxm1*lmaxm1,kmaxm1,lmaxm1, +c . histoW, zx_tmp_3d) + + CALL histwrite(nid_regdyn,"hw1",itau_w,histoW(:,:,:,1), + & kmaxm1*lmaxm1*iwmax,ndex3d) +c + CALL histwrite(nid_regdyn,"nh1",itau_w,nhistoW(:,:,:,1), + & kmaxm1*lmaxm1*iwmax,ndex3d) +c + CALL histwrite(nid_regdyn,"nht1",itau_w,nhistoWt(:,:,:,1), + & kmaxm1*lmaxm1*iwmax,ndex3d) +c + CALL histwrite(nid_regdyn,"hw2",itau_w,histoW(:,:,:,2), + & kmaxm1*lmaxm1*iwmax,ndex3d) +c + CALL histwrite(nid_regdyn,"nh2",itau_w,nhistoW(:,:,:,2), + & kmaxm1*lmaxm1*iwmax,ndex3d) +c + CALL histwrite(nid_regdyn,"nht2",itau_w,nhistoWt(:,:,:,2), + & kmaxm1*lmaxm1*iwmax,ndex3d) +c + CALL histwrite(nid_regdyn,"hw3",itau_w,histoW(:,:,:,3), + & kmaxm1*lmaxm1*iwmax,ndex3d) +c + CALL histwrite(nid_regdyn,"nh3",itau_w,nhistoW(:,:,:,3), + & kmaxm1*lmaxm1*iwmax,ndex3d) +c + CALL histwrite(nid_regdyn,"nht3",itau_w,nhistoWt(:,:,:,3), + & kmaxm1*lmaxm1*iwmax,ndex3d) +c + CALL histwrite(nid_regdyn,"hw4",itau_w,histoW(:,:,:,4), + & kmaxm1*lmaxm1*iwmax,ndex3d) +c + CALL histwrite(nid_regdyn,"nh4",itau_w,nhistoW(:,:,:,4), + & kmaxm1*lmaxm1*iwmax,ndex3d) +c + CALL histwrite(nid_regdyn,"nht4",itau_w,nhistoWt(:,:,:,4), + & kmaxm1*lmaxm1*iwmax,ndex3d) +c + CALL histwrite(nid_regdyn,"hw5",itau_w,histoW(:,:,:,5), + & kmaxm1*lmaxm1*iwmax,ndex3d) +c + CALL histwrite(nid_regdyn,"nh5",itau_w,nhistoW(:,:,:,5), + & kmaxm1*lmaxm1*iwmax,ndex3d) +c + CALL histwrite(nid_regdyn,"nht5",itau_w,nhistoWt(:,:,:,5), + & kmaxm1*lmaxm1*iwmax,ndex3d) + + if (ok_sync) then + call histsync(nid_regdyn) + endif + + endif Index: /LMDZ.3.3/branches/rel-LF/libf/phylmd/write_histmthNMC.h =================================================================== --- /LMDZ.3.3/branches/rel-LF/libf/phylmd/write_histmthNMC.h (revision 500) +++ /LMDZ.3.3/branches/rel-LF/libf/phylmd/write_histmthNMC.h (revision 500) @@ -0,0 +1,158 @@ +c IF (ok_mensuelNMC) THEN + IF (ok_mensuel) THEN +c + ndex2d = 0 + ndex3d = 0 +c +c Champs 2D: +c + + zsto = dtime + zout = dtime * ecrit_mth + itau_w = itau_phy + itap + + i = NINT(zout/zsto) +c +c Champs interpolles sur des niveaux de pression du NMC +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1, u1000,zx_tmp_2d) + CALL histwrite(nid_nmc, + ."u1000",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1, v1000,zx_tmp_2d) + CALL histwrite(nid_nmc, + ."v1000",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1, u925,zx_tmp_2d) + CALL histwrite(nid_nmc, + ."u925",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1, v925,zx_tmp_2d) + CALL histwrite(nid_nmc, + ."v925",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1, u850,zx_tmp_2d) + CALL histwrite(nid_nmc, + ."u850",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d) +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1, v850,zx_tmp_2d) + CALL histwrite(nid_nmc,"v850",itau_w, + .zx_tmp_2d,iim*jjmp1,ndex2d) +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1, u700,zx_tmp_2d) + CALL histwrite(nid_nmc,"u700",itau_w, + .zx_tmp_2d,iim*jjmp1,ndex2d) +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1, v700,zx_tmp_2d) + CALL histwrite(nid_nmc,"v700",itau_w, + .zx_tmp_2d,iim*jjmp1,ndex2d) +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1, u600,zx_tmp_2d) + CALL histwrite(nid_nmc,"u600",itau_w, + .zx_tmp_2d,iim*jjmp1,ndex2d) +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1, v600,zx_tmp_2d) + CALL histwrite(nid_nmc,"v600",itau_w, + .zx_tmp_2d,iim*jjmp1,ndex2d) +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1, u500,zx_tmp_2d) + CALL histwrite(nid_nmc,"u500",itau_w, + .zx_tmp_2d,iim*jjmp1,ndex2d) +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1, v500,zx_tmp_2d) + CALL histwrite(nid_nmc,"v500",itau_w, + .zx_tmp_2d,iim*jjmp1,ndex2d) +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1, u400,zx_tmp_2d) + CALL histwrite(nid_nmc,"u400",itau_w, + .zx_tmp_2d,iim*jjmp1,ndex2d) +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1, v400,zx_tmp_2d) + CALL histwrite(nid_nmc,"v400",itau_w, + .zx_tmp_2d,iim*jjmp1,ndex2d) +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1, u300,zx_tmp_2d) + CALL histwrite(nid_nmc,"u300",itau_w, + .zx_tmp_2d,iim*jjmp1,ndex2d) +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1, v300,zx_tmp_2d) + CALL histwrite(nid_nmc,"v300",itau_w, + .zx_tmp_2d,iim*jjmp1,ndex2d) +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1, u250,zx_tmp_2d) + CALL histwrite(nid_nmc,"u250",itau_w, + .zx_tmp_2d,iim*jjmp1,ndex2d) +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1, v250,zx_tmp_2d) + CALL histwrite(nid_nmc,"v250",itau_w, + .zx_tmp_2d,iim*jjmp1,ndex2d) +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1, u200,zx_tmp_2d) + CALL histwrite(nid_nmc,"u200",itau_w, + .zx_tmp_2d,iim*jjmp1,ndex2d) +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1, v200,zx_tmp_2d) + CALL histwrite(nid_nmc,"v200",itau_w, + .zx_tmp_2d,iim*jjmp1,ndex2d) +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1, u150,zx_tmp_2d) + CALL histwrite(nid_nmc,"u150",itau_w, + .zx_tmp_2d,iim*jjmp1,ndex2d) +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1, v150,zx_tmp_2d) + CALL histwrite(nid_nmc,"v150",itau_w, + .zx_tmp_2d,iim*jjmp1,ndex2d) +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1, u100,zx_tmp_2d) + CALL histwrite(nid_nmc,"u100",itau_w, + .zx_tmp_2d,iim*jjmp1,ndex2d) +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1, v100,zx_tmp_2d) + CALL histwrite(nid_nmc,"v100",itau_w, + .zx_tmp_2d,iim*jjmp1,ndex2d) +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1, u70,zx_tmp_2d) + CALL histwrite(nid_nmc,"u70",itau_w, + .zx_tmp_2d,iim*jjmp1,ndex2d) +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1, v70,zx_tmp_2d) + CALL histwrite(nid_nmc,"v70",itau_w, + .zx_tmp_2d,iim*jjmp1,ndex2d) +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1, u50,zx_tmp_2d) + CALL histwrite(nid_nmc,"u50",itau_w, + .zx_tmp_2d,iim*jjmp1,ndex2d) +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1, v50,zx_tmp_2d) + CALL histwrite(nid_nmc,"v50",itau_w, + .zx_tmp_2d,iim*jjmp1,ndex2d) +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1, u30,zx_tmp_2d) + CALL histwrite(nid_nmc,"u30",itau_w, + .zx_tmp_2d,iim*jjmp1,ndex2d) +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1, v30,zx_tmp_2d) + CALL histwrite(nid_nmc,"v30",itau_w, + .zx_tmp_2d,iim*jjmp1,ndex2d) +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1, u20,zx_tmp_2d) + CALL histwrite(nid_nmc,"u20",itau_w, + .zx_tmp_2d,iim*jjmp1,ndex2d) +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1, v20,zx_tmp_2d) + CALL histwrite(nid_nmc,"v20",itau_w, + .zx_tmp_2d,iim*jjmp1,ndex2d) +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1, u10,zx_tmp_2d) + CALL histwrite(nid_nmc,"u10",itau_w, + .zx_tmp_2d,iim*jjmp1,ndex2d) +c + CALL gr_fi_ecrit(1, klon,iim,jjmp1, v10,zx_tmp_2d) + CALL histwrite(nid_nmc,"v10",itau_w, + .zx_tmp_2d,iim*jjmp1,ndex2d) + + if (ok_sync) then + call histsync(nid_nmc) + endif + + ENDIF