/[lmdze]/trunk/Sources/phylmd/phytrac.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/phytrac.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 200 by guez, Mon May 9 19:56:28 2016 UTC revision 201 by guez, Mon Jun 6 17:42:15 2016 UTC
# Line 12  contains Line 12  contains
12         entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, da, phi, &         entr_therm, yu1, yv1, ftsol, pctsrf, frac_impa, frac_nucl, da, phi, &
13         mp, upwd, dnwd, tr_seri, zmasse, ncid_startphy)         mp, upwd, dnwd, tr_seri, zmasse, ncid_startphy)
14    
15      ! From phylmd/phytrac.F, version 1.15 2006/02/21 08:08:30 (SVN revision 679)      ! From phylmd/phytrac.F, version 1.15 2006/02/21 08:08:30 (SVN
16        ! revision 679) and phylmd/write_histrac.h, version 1.9 2006/02/21
17        ! 08:08:30
18    
19      ! Authors: Fr\'ed\'eric Hourdin, Abderrahmane Idelkadi, Marie-Alice      ! Authors: Fr\'ed\'eric Hourdin, Abderrahmane Idelkadi, Marie-Alice
20      ! Foujols, Olivia      ! Foujols, Olivia
# Line 35  contains Line 37  contains
37      use cvltr_m, only: cvltr      use cvltr_m, only: cvltr
38      use dimens_m, only: llm, nqmx      use dimens_m, only: llm, nqmx
39      use dimphy, only: klon      use dimphy, only: klon
40        use histwrite_phy_m, only: histwrite_phy
41      use indicesol, only: nbsrf      use indicesol, only: nbsrf
42        use iniadvtrac_m, only: tname
43      use initrrnpb_m, only: initrrnpb      use initrrnpb_m, only: initrrnpb
44      use minmaxqfi_m, only: minmaxqfi      use minmaxqfi_m, only: minmaxqfi
45      use netcdf, only: NF90_FILL_float      use netcdf, only: NF90_FILL_float
# Line 395  contains Line 399  contains
399      ENDIF      ENDIF
400    
401      ! Ecriture des sorties      ! Ecriture des sorties
402      call write_histrac(lessivage)      CALL histwrite_phy("zmasse", zmasse)
403        DO it=1, nqmx - 2
404           CALL histwrite_phy(tname(it+2), tr_seri(:, :, it))
405           if (lessivage) THEN
406              CALL histwrite_phy("fl"//tname(it+2), flestottr(:, :, it))
407           endif
408           CALL histwrite_phy("d_tr_th_"//tname(it+2), d_tr_th(:, :, it))
409           CALL histwrite_phy("d_tr_cv_"//tname(it+2), d_tr_cv(:, :, it))
410           CALL histwrite_phy("d_tr_cl_"//tname(it+2), d_tr_cl(:, :, it))
411        ENDDO
412    
413      if (lafin) then      if (lafin) then
414         call nf95_inq_varid(ncid_restartphy, "trs", varid)         call nf95_inq_varid(ncid_restartphy, "trs", varid)
415         call nf95_put_var(ncid_restartphy, varid, trs(:, 1))         call nf95_put_var(ncid_restartphy, varid, trs(:, 1))
416      endif      endif
417    
   contains  
   
     subroutine write_histrac(lessivage)  
   
       ! From phylmd/write_histrac.h, version 1.9 2006/02/21 08:08:30  
   
       use gr_phy_write_m, only: gr_phy_write  
       use histwrite_m, only: histwrite  
       use iniadvtrac_m, only: tname  
       use ini_histins_m, only: nid_ins  
       use phyetat0_m, only: itau_phy  
   
       logical, intent(in):: lessivage  
   
       ! Variables local to the procedure:  
       integer it  
       integer itau_w ! pas de temps ecriture  
   
       !-----------------------------------------------------  
   
       itau_w = itau_phy + itap  
   
       CALL histwrite(nid_ins, "zmasse", itau_w, gr_phy_write(zmasse))  
   
       DO it=1, nqmx - 2  
          CALL histwrite(nid_ins, tname(it+2), itau_w, &  
               gr_phy_write(tr_seri(:, :, it)))  
          if (lessivage) THEN  
             CALL histwrite(nid_ins, "fl"//tname(it+2), itau_w, &  
                  gr_phy_write(flestottr(:, :, it)))  
          endif  
          CALL histwrite(nid_ins, "d_tr_th_"//tname(it+2), itau_w, &  
               gr_phy_write(d_tr_th(:, :, it)))  
          CALL histwrite(nid_ins, "d_tr_cv_"//tname(it+2), itau_w, &  
               gr_phy_write(d_tr_cv(:, :, it)))  
          CALL histwrite(nid_ins, "d_tr_cl_"//tname(it+2), itau_w, &  
               gr_phy_write(d_tr_cl(:, :, it)))  
       ENDDO  
   
     end subroutine write_histrac  
   
418    END SUBROUTINE phytrac    END SUBROUTINE phytrac
419    
420  end module phytrac_m  end module phytrac_m
Legend:
Removed from v.200  
changed lines
  Added in v.201
  ViewVC Help
Powered by ViewVC 1.1.21