--- trunk/bibio/writehist.f	2014/03/06 15:12:00	83
+++ trunk/dyn3d/writehist.f	2018/12/11 22:48:09	321
@@ -4,98 +4,69 @@
 
 contains
 
-  subroutine writehist(time, vcov, ucov, teta, phi, q, masse, ps)
+  subroutine writehist(vcov, ucov, teta, pk, phi, q, masse, ps, itau_w)
 
-    ! From writehist.F 1403 2010-07-01 09:02:53Z
+    ! From writehist.F, revision 1403, 2010-07-01 09:02:53
     ! Écriture du fichier histoire au format IOIPSL
-    ! Appels successifs des routines histwrite
     ! L. Fairhead, LMD, 03/99
 
-    use dimens_m, only: nqmx, llm, jjm
-    USE iniadvtrac_m, ONLY: ttext
-    use com_io_dyn, only: histid, histvid, histuid
-    use paramet_m, only: ip1jm, ip1jmp1, iip1, jjp1
-    use temps, only: itau_dyn
-    use histwrite_m, only: histwrite
-    use histsync_m, only: histsync
+    USE comconst, ONLY: cpp
     use covnat_m, only: covnat
+    use dimensions, only: llm
+    use histsync_m, only: histsync
+    use histwrite_m, only: histwrite
+    use infotrac_init_m, only: ttext
+    use inithist_m, only: histid, histvid, histuid
+    use nr_util, only: assert
+    use paramet_m, only: ip1jm, ip1jmp1
+
+    ! Vent covariant :
+    REAL, intent(in):: vcov(:, :, :) ! (iim + 1, jjm, llm)
+    REAL, intent(in):: ucov(:, :, :) ! (iim + 1, jjm + 1, llm)
+
+    REAL, intent(in):: teta(:, :, :) ! (iim + 1, jjm + 1, llm)
+    ! temperature potentielle
+
+    real, intent(in):: pk(:, :, :) ! (iim + 1, jjm + 1, llm)
+    real, intent(in):: phi(:, :, :) ! (iim + 1, jjm + 1, llm) ! geopotential
+    REAL, intent(in):: q(:, :, :, :) ! (iim + 1, jjm + 1, llm, nqmx) traceurs
+    real, intent(in):: masse(:, :, :) ! (iim + 1, jjm + 1, llm)
+    REAL, intent(in):: ps(:, :) ! (iim + 1, jjm + 1) pression au sol
+    integer, intent(in):: itau_w ! temps de l'ecriture
 
-    ! Entree:
-    ! time: temps de l'ecriture
-    ! vcov: vents v covariants
-    ! ucov: vents u covariants
-    ! teta: temperature potentielle
-    ! phi : geopotentiel instantane
-    ! q : traceurs
-    ! masse: masse
-    ! ps :pression au sol
-
-    ! Arguments
-
-    REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm) 
-    REAL teta(ip1jmp1, llm), phi(ip1jmp1, llm) 
-    REAL, intent(in):: ps(ip1jmp1), masse(ip1jmp1, llm) 
-    REAL q(ip1jmp1, llm, nqmx)
-    integer time
-
-    ! This routine needs IOIPSL to work
-    ! Variables locales
-
-    integer iq, ii, ll
-    integer ndexu(ip1jmp1*llm), ndexv(ip1jm*llm), ndex2d(ip1jmp1)
-    logical ok_sync
-    integer itau_w
+    ! Local:
+    integer iq
     REAL vnat(ip1jm, llm), unat(ip1jmp1, llm)
 
     !---------------------------------------------------------------------
 
-    ! Initialisations
+    call assert([size(vcov, 1), size(ucov, 1), size(teta, 1), size(phi, 1), &
+         size(pk, 1), size(ps, 1), size(masse, 1)] == size(q, 1), &
+         "writehist iim")
+    call assert([size(vcov, 2) + 1, size(ucov, 2), size(teta, 2), &
+         size(phi, 2), size(pk, 2), size(ps, 2), size(masse, 2)] &
+         == size(q, 2), "writehist jjm")
+    call assert([size(vcov, 3), size(ucov, 3), size(teta, 3), size(phi, 3), &
+         size(pk, 3), size(masse, 3), size(q, 3)] == llm, "writehist llm")
 
-    ndexu = 0
-    ndexv = 0
-    ndex2d = 0
-    ok_sync =.TRUE.
-    itau_w = itau_dyn + time
-    ! Passage aux composantes naturelles du vent
     call covnat(llm, ucov, vcov, unat, vnat)
 
-    ! Appels a histwrite pour l'ecriture des variables a sauvegarder
-
-    ! Vents U
-
     call histwrite(histuid, 'u', itau_w, unat)
-
-    ! Vents V
-
     call histwrite(histvid, 'v', itau_w, vnat)
-
-    ! Temperature potentielle
-
-    call histwrite(histid, 'teta', itau_w, teta)
-
-    ! Geopotentiel
-
+    call histwrite(histid, 'theta', itau_w, teta)
+    call histwrite(histid, 'temp', itau_w, teta * pk / cpp)
     call histwrite(histid, 'phi', itau_w, phi)
 
-    ! Traceurs
-
-    ! DO iq=1, nqmx
-    ! call histwrite(histid, ttext(iq), itau_w, q(:, :, iq), 
-    ! . iip1*jjp1*llm, ndexu)
-    ! enddo
-    !C
-    ! Masse
+    DO iq = 1, size(q, 4)
+       call histwrite(histid, ttext(iq), itau_w, q(:, :, :, iq))
+    enddo
 
     call histwrite(histid, 'masse', itau_w, masse)
-
-    ! Pression au sol
     call histwrite(histid, 'ps', itau_w, ps)
 
-    if (ok_sync) then
-       call histsync(histid)
-       call histsync(histvid)
-       call histsync(histuid)
-    endif
+    call histsync(histid)
+    call histsync(histvid)
+    call histsync(histuid)
 
   end subroutine writehist