Changeset 5114
- Timestamp:
- Jul 24, 2024, 1:27:51 PM (7 weeks ago)
- Location:
- LMDZ6/branches/Amaury_dev/libf
- Files:
-
- 26 edited
- 2 moved
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/libf/dyn3d/advtrac.f90
r5103 r5114 14 14 USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_DEBUGIO 15 15 USE strings_mod, ONLY: int2str 16 USE lmdz_description, ONLY: descript 16 17 17 18 IMPLICIT NONE … … 21 22 include "comdissip.h" 22 23 include "comgeom2.h" 23 include "description.h"24 24 include "iniprint.h" 25 25 -
LMDZ6/branches/Amaury_dev/libf/dyn3d/dynetat0.F90
r5113 r5114 20 20 USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0 21 21 USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA 22 USE lmdz_description, ONLY: descript 22 23 23 24 IMPLICIT NONE … … 25 26 include "paramet.h" 26 27 include "comgeom2.h" 27 include "description.h"28 28 include "iniprint.h" 29 29 !=============================================================================== -
LMDZ6/branches/Amaury_dev/libf/dyn3d/dynredem.F90
r5103 r5114 18 18 USE temps_mod, ONLY: annee_ref, day_ref, itau_dyn, itaufin, start_time 19 19 USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0 20 USE lmdz_description, ONLY: descript 20 21 21 22 IMPLICIT NONE … … 23 24 include "paramet.h" 24 25 include "comgeom2.h" 25 include "description.h"26 26 include "iniprint.h" 27 27 !=============================================================================== … … 165 165 err, modname, fil, msg 166 166 USE temps_mod, ONLY: itau_dyn, itaufin 167 USE lmdz_description, ONLY: descript 167 168 168 169 IMPLICIT NONE 169 170 include "dimensions.h" 170 171 include "paramet.h" 171 include "description.h"172 172 include "comgeom.h" 173 173 include "iniprint.h" -
LMDZ6/branches/Amaury_dev/libf/dyn3d/gcm.F90
r5106 r5114 19 19 20 20 USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_PHYS 21 USE lmdz_description, ONLY: descript 21 22 22 23 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! … … 64 65 include "comdissnew.h" 65 66 include "comgeom.h" 66 include "description.h"67 67 include "iniprint.h" 68 68 include "tracstoke.h" -
LMDZ6/branches/Amaury_dev/libf/dyn3d/leapfrog.F90
r5113 r5114 25 25 USE strings_mod, ONLY: msg 26 26 USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_PHYS 27 USE lmdz_description, ONLY: descript 27 28 28 29 IMPLICIT NONE … … 63 64 include "comdissnew.h" 64 65 include "comgeom.h" 65 include "description.h"66 66 include "iniprint.h" 67 67 include "academic.h" -
LMDZ6/branches/Amaury_dev/libf/dyn3d_common/adaptdt.f90
r5105 r5114 6 6 7 7 USE comconst_mod, ONLY: dtvr 8 USE lmdz_description, ONLY: descript 8 9 IMPLICIT NONE 9 10 … … 12 13 include "comdissip.h" 13 14 include "comgeom2.h" 14 include "description.h"15 15 16 16 !---------------------------------------------------------- -
LMDZ6/branches/Amaury_dev/libf/dyn3d_common/fyhyp_m.F90
r2598 r5114 16 16 ! Il vaut mieux avoir : grossismy * dzoom < pi / 2 17 17 18 use coefpoly_m, only: coefpoly18 use lmdz_coefpoly, only: coefpoly 19 19 use nrtype, only: k8 20 20 use serre_mod, only: clat, grossismy, dzoomy, tauy -
LMDZ6/branches/Amaury_dev/libf/dyn3d_common/initdynav.F90
r5113 r5114 10 10 USE comvert_mod, ONLY: presnivs 11 11 USE temps_mod, ONLY: itau_dyn 12 USE lmdz_description, ONLY: descript 12 13 13 14 IMPLICIT NONE … … 37 38 include "paramet.h" 38 39 include "comgeom.h" 39 include "description.h"40 40 include "iniprint.h" 41 41 -
LMDZ6/branches/Amaury_dev/libf/dyn3d_common/initfluxsto.f90
r5113 r5114 1 2 1 ! $Id$ 3 2 4 3 SUBROUTINE initfluxsto & 5 (infile, tstep,t_ops,t_wrt, &6 fileid, filevid,filedid)7 8 4 (infile, tstep, t_ops, t_wrt, & 5 fileid, filevid, filedid) 6 7 USE IOIPSL 9 8 USE comconst_mod, ONLY: pi 10 9 USE comvert_mod, ONLY: nivsigs 11 10 USE temps_mod, ONLY: annee_ref, day_ref, itau_dyn 11 USE lmdz_description, ONLY: descript 12 12 13 13 IMPLICIT NONE … … 43 43 include "paramet.h" 44 44 include "comgeom.h" 45 include "description.h"46 45 include "iniprint.h" 47 46 48 47 ! Arguments 49 48 ! 50 character(len =*) :: infile49 character(len = *) :: infile 51 50 real :: tstep, t_ops, t_wrt 52 integer :: fileid, filevid, filedid51 integer :: fileid, filevid, filedid 53 52 54 53 ! This routine needs IOIPSL to work … … 58 57 integer :: tau0 59 58 real :: zjulian 60 character(len =3) :: str61 character(len =10) :: ctrac59 character(len = 3) :: str 60 character(len = 10) :: ctrac 62 61 integer :: iq 63 real :: rlong(iip1, jjp1), rlat(iip1,jjp1),rl(1,1)64 integer :: uhoriid, vhoriid, thoriid, zvertiid, dhoriid,dvertiid65 integer :: ii, jj62 real :: rlong(iip1, jjp1), rlat(iip1, jjp1), rl(1, 1) 63 integer :: uhoriid, vhoriid, thoriid, zvertiid, dhoriid, dvertiid 64 integer :: ii, jj 66 65 integer :: zan, idayref 67 66 logical :: ok_sync … … 70 69 ! 71 70 pi = 4. * atan (1.) 72 str ='q '71 str = 'q ' 73 72 ctrac = 'traceur ' 74 73 ok_sync = .TRUE. … … 82 81 tau0 = itau_dyn 83 82 84 83 do jj = 1, jjp1 85 84 do ii = 1, iip1 86 rlong(ii, jj) = rlonu(ii) * 180. / pi87 rlat(ii, jj) = rlatu(jj) * 180. / pi85 rlong(ii, jj) = rlonu(ii) * 180. / pi 86 rlat(ii, jj) = rlatu(jj) * 180. / pi 88 87 enddo 89 88 enddo 90 89 91 CALL histbeg(infile, iip1, rlong(:, 1), jjp1, rlat(1,:), &92 1, iip1, 1, jjp1, &93 tau0, zjulian, tstep, uhoriid, fileid)90 CALL histbeg(infile, iip1, rlong(:, 1), jjp1, rlat(1, :), & 91 1, iip1, 1, jjp1, & 92 tau0, zjulian, tstep, uhoriid, fileid) 94 93 ! 95 94 ! Creation du fichier histoire pour la grille en V (oblige pour l'instant, … … 97 96 ! un meme fichier) 98 97 99 100 98 do jj = 1, jjm 101 99 do ii = 1, iip1 102 rlong(ii, jj) = rlonv(ii) * 180. / pi103 rlat(ii, jj) = rlatv(jj) * 180. / pi100 rlong(ii, jj) = rlonv(ii) * 180. / pi 101 rlat(ii, jj) = rlatv(jj) * 180. / pi 104 102 enddo 105 103 enddo 106 104 107 CALL histbeg('fluxstokev.nc', iip1, rlong(:, 1), jjm, rlat(1,:), &108 1, iip1, 1, jjm, &109 tau0, zjulian, tstep, vhoriid, filevid)110 111 rl(1,1) = 1.105 CALL histbeg('fluxstokev.nc', iip1, rlong(:, 1), jjm, rlat(1, :), & 106 1, iip1, 1, jjm, & 107 tau0, zjulian, tstep, vhoriid, filevid) 108 109 rl(1, 1) = 1. 112 110 CALL histbeg('defstoke.nc', 1, rl, 1, rl, & 113 1, 1, 1, 1, &114 tau0, zjulian, tstep, dhoriid, filedid)111 1, 1, 1, 1, & 112 tau0, zjulian, tstep, dhoriid, filedid) 115 113 116 114 ! … … 119 117 do jj = 1, jjp1 120 118 do ii = 1, iip1 121 rlong(ii, jj) = rlonv(ii) * 180. / pi122 rlat(ii, jj) = rlatu(jj) * 180. / pi119 rlong(ii, jj) = rlonv(ii) * 180. / pi 120 rlat(ii, jj) = rlatu(jj) * 180. / pi 123 121 enddo 124 122 enddo 125 123 126 124 CALL histhori(fileid, iip1, rlong, jjp1, rlat, 'scalar', & 127 'Grille points scalaires', thoriid)125 'Grille points scalaires', thoriid) 128 126 129 127 ! … … 131 129 ! 132 130 CALL histvert(fileid, 'sig_s', 'Niveaux sigma', & 133 'sigma_level', &134 llm, nivsigs, zvertiid)131 'sigma_level', & 132 llm, nivsigs, zvertiid) 135 133 ! Pour le fichier V 136 134 CALL histvert(filevid, 'sig_s', 'Niveaux sigma', & 137 'sigma_level', &138 llm, nivsigs, zvertiid)135 'sigma_level', & 136 llm, nivsigs, zvertiid) 139 137 ! pour le fichier def 140 138 nivd(1) = 1 141 139 CALL histvert(filedid, 'sig_s', 'Niveaux sigma', & 142 'sigma_level', &143 1, nivd, dvertiid)140 'sigma_level', & 141 1, nivd, dvertiid) 144 142 145 143 ! 146 144 ! Appels a histdef pour la definition des variables a sauvegarder 147 145 148 149 iip1, jjp1,thoriid, 1,1,1, -99, 32, &150 "once", t_ops, t_wrt) 151 152 153 iip1,jjp1,thoriid, 1,1,1, -99, 32, &154 155 156 157 1, 1,dhoriid, 1,1,1, -99, 32, &158 "once", t_ops, t_wrt) 159 160 161 1,1,dhoriid, 1,1,1, -99, 32, &162 163 164 165 1,1,dhoriid, 1,1,1, -99, 32, &166 146 CALL histdef(fileid, "phis", "Surface geop. height", "-", & 147 iip1, jjp1, thoriid, 1, 1, 1, -99, 32, & 148 "once", t_ops, t_wrt) 149 150 CALL histdef(fileid, "aire", "Grid area", "-", & 151 iip1, jjp1, thoriid, 1, 1, 1, -99, 32, & 152 "once", t_ops, t_wrt) 153 154 CALL histdef(filedid, "dtvr", "tps dyn", "s", & 155 1, 1, dhoriid, 1, 1, 1, -99, 32, & 156 "once", t_ops, t_wrt) 157 158 CALL histdef(filedid, "istdyn", "tps stock", "s", & 159 1, 1, dhoriid, 1, 1, 1, -99, 32, & 160 "once", t_ops, t_wrt) 161 162 CALL histdef(filedid, "istphy", "tps stock phy", "s", & 163 1, 1, dhoriid, 1, 1, 1, -99, 32, & 164 "once", t_ops, t_wrt) 167 165 168 166 … … 171 169 ! 172 170 CALL histdef(fileid, 'masse', 'Masse', 'kg', & 173 iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &174 32, 'inst(X)', t_ops, t_wrt)171 iip1, jjp1, thoriid, llm, 1, llm, zvertiid, & 172 32, 'inst(X)', t_ops, t_wrt) 175 173 ! 176 174 ! Pbaru 177 175 ! 178 176 CALL histdef(fileid, 'pbaru', 'flx de masse zonal', 'kg m/s', & 179 iip1, jjp1, uhoriid, llm, 1, llm, zvertiid, &180 32, 'inst(X)', t_ops, t_wrt)177 iip1, jjp1, uhoriid, llm, 1, llm, zvertiid, & 178 32, 'inst(X)', t_ops, t_wrt) 181 179 182 180 ! … … 184 182 ! 185 183 CALL histdef(filevid, 'pbarv', 'flx de masse mer', 'kg m/s', & 186 iip1, jjm, vhoriid, llm, 1, llm, zvertiid, &187 32, 'inst(X)', t_ops, t_wrt)184 iip1, jjm, vhoriid, llm, 1, llm, zvertiid, & 185 32, 'inst(X)', t_ops, t_wrt) 188 186 ! 189 187 ! w 190 188 ! 191 189 CALL histdef(fileid, 'w', 'flx de masse vert', 'kg m/s', & 192 iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &193 32, 'inst(X)', t_ops, t_wrt)190 iip1, jjp1, thoriid, llm, 1, llm, zvertiid, & 191 32, 'inst(X)', t_ops, t_wrt) 194 192 195 193 ! … … 197 195 ! 198 196 CALL histdef(fileid, 'teta', 'temperature potentielle', '-', & 199 iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &200 32, 'inst(X)', t_ops, t_wrt)197 iip1, jjp1, thoriid, llm, 1, llm, zvertiid, & 198 32, 'inst(X)', t_ops, t_wrt) 201 199 ! 202 200 … … 205 203 ! 206 204 CALL histdef(fileid, 'phi', 'geopotentiel instantane', '-', & 207 iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &208 32, 'inst(X)', t_ops, t_wrt)205 iip1, jjp1, thoriid, llm, 1, llm, zvertiid, & 206 32, 'inst(X)', t_ops, t_wrt) 209 207 ! 210 208 ! Fin -
LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inithist.F90
r5113 r5114 3 3 SUBROUTINE inithist(day0, anne0, tstep, t_ops, t_wrt) 4 4 5 5 USE IOIPSL 6 6 USE infotrac, ONLY: nqtot 7 usecom_io_dyn_mod, ONLY: histid, histvid, histuid, &7 USE com_io_dyn_mod, ONLY: histid, histvid, histuid, & 8 8 dynhist_file, dynhistv_file, dynhistu_file 9 9 USE comconst_mod, ONLY: pi 10 10 USE comvert_mod, ONLY: presnivs 11 11 USE temps_mod, ONLY: itau_dyn 12 USE lmdz_description, ONLY: descript 12 13 13 14 IMPLICIT NONE … … 41 42 include "paramet.h" 42 43 include "comgeom.h" 43 include "description.h"44 44 include "iniprint.h" 45 45 … … 55 55 real :: zjulian 56 56 integer :: iq 57 real :: rlong(iip1, jjp1), rlat(iip1,jjp1)57 real :: rlong(iip1, jjp1), rlat(iip1, jjp1) 58 58 integer :: uhoriid, vhoriid, thoriid, zvertiid 59 integer :: ii, jj59 integer :: ii, jj 60 60 integer :: zan, dayref 61 61 ! … … 78 78 do jj = 1, jjp1 79 79 do ii = 1, iip1 80 rlong(ii, jj) = rlonu(ii) * 180. / pi81 rlat(ii, jj) = rlatu(jj) * 180. / pi80 rlong(ii, jj) = rlonu(ii) * 180. / pi 81 rlat(ii, jj) = rlatu(jj) * 180. / pi 82 82 enddo 83 83 enddo 84 84 85 CALL histbeg(dynhistu_file, iip1, rlong(:, 1), jjp1, rlat(1,:), &86 1, iip1, 1, jjp1, &87 tau0, zjulian, tstep, uhoriid, histuid)85 CALL histbeg(dynhistu_file, iip1, rlong(:, 1), jjp1, rlat(1, :), & 86 1, iip1, 1, jjp1, & 87 tau0, zjulian, tstep, uhoriid, histuid) 88 88 89 89 ! Grille V 90 90 do jj = 1, jjm 91 91 do ii = 1, iip1 92 rlong(ii, jj) = rlonv(ii) * 180. / pi93 rlat(ii, jj) = rlatv(jj) * 180. / pi92 rlong(ii, jj) = rlonv(ii) * 180. / pi 93 rlat(ii, jj) = rlatv(jj) * 180. / pi 94 94 enddo 95 95 enddo 96 96 97 CALL histbeg(dynhistv_file, iip1, rlong(:, 1), jjm, rlat(1,:), &98 1, iip1, 1, jjm, &99 tau0, zjulian, tstep, vhoriid, histvid)97 CALL histbeg(dynhistv_file, iip1, rlong(:, 1), jjm, rlat(1, :), & 98 1, iip1, 1, jjm, & 99 tau0, zjulian, tstep, vhoriid, histvid) 100 100 101 101 !Grille Scalaire 102 102 do jj = 1, jjp1 103 103 do ii = 1, iip1 104 rlong(ii, jj) = rlonv(ii) * 180. / pi105 rlat(ii, jj) = rlatu(jj) * 180. / pi104 rlong(ii, jj) = rlonv(ii) * 180. / pi 105 rlat(ii, jj) = rlatu(jj) * 180. / pi 106 106 enddo 107 107 enddo 108 108 109 CALL histbeg(dynhist_file, iip1, rlong(:, 1), jjp1, rlat(1,:), &110 1, iip1, 1, jjp1, &111 tau0, zjulian, tstep, thoriid, histid)109 CALL histbeg(dynhist_file, iip1, rlong(:, 1), jjp1, rlat(1, :), & 110 1, iip1, 1, jjp1, & 111 tau0, zjulian, tstep, thoriid, histid) 112 112 ! ------------------------------------------------------------- 113 113 ! Appel a histvert pour la grille verticale 114 114 ! ------------------------------------------------------------- 115 CALL histvert(histid, 'presnivs', 'Niveaux pression', 'mb', &116 llm, presnivs/100., zvertiid,'down')117 CALL histvert(histvid, 'presnivs', 'Niveaux pression', 'mb', &118 llm, presnivs/100., zvertiid,'down')119 CALL histvert(histuid, 'presnivs', 'Niveaux pression', 'mb', &120 llm, presnivs/100., zvertiid,'down')115 CALL histvert(histid, 'presnivs', 'Niveaux pression', 'mb', & 116 llm, presnivs / 100., zvertiid, 'down') 117 CALL histvert(histvid, 'presnivs', 'Niveaux pression', 'mb', & 118 llm, presnivs / 100., zvertiid, 'down') 119 CALL histvert(histuid, 'presnivs', 'Niveaux pression', 'mb', & 120 llm, presnivs / 100., zvertiid, 'down') 121 121 ! 122 122 ! ------------------------------------------------------------- … … 127 127 ! 128 128 CALL histdef(histuid, 'u', 'vent u', 'm/s', & 129 iip1, jjp1, uhoriid, llm, 1, llm, zvertiid, &130 32, 'inst(X)', t_ops, t_wrt)129 iip1, jjp1, uhoriid, llm, 1, llm, zvertiid, & 130 32, 'inst(X)', t_ops, t_wrt) 131 131 ! 132 132 ! Vents V 133 133 ! 134 134 CALL histdef(histvid, 'v', 'vent v', 'm/s', & 135 iip1, jjm, vhoriid, llm, 1, llm, zvertiid, &136 32, 'inst(X)', t_ops, t_wrt)135 iip1, jjm, vhoriid, llm, 1, llm, zvertiid, & 136 32, 'inst(X)', t_ops, t_wrt) 137 137 138 138 ! … … 140 140 ! 141 141 CALL histdef(histid, 'teta', 'temperature potentielle', '-', & 142 iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &143 32, 'inst(X)', t_ops, t_wrt)142 iip1, jjp1, thoriid, llm, 1, llm, zvertiid, & 143 32, 'inst(X)', t_ops, t_wrt) 144 144 ! 145 145 ! Geopotentiel 146 146 ! 147 147 CALL histdef(histid, 'phi', 'geopotentiel', '-', & 148 iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &149 32, 'inst(X)', t_ops, t_wrt)148 iip1, jjp1, thoriid, llm, 1, llm, zvertiid, & 149 32, 'inst(X)', t_ops, t_wrt) 150 150 ! 151 151 ! Traceurs … … 162 162 ! 163 163 CALL histdef(histid, 'masse', 'masse', 'kg', & 164 iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &165 32, 'inst(X)', t_ops, t_wrt)164 iip1, jjp1, thoriid, llm, 1, llm, zvertiid, & 165 32, 'inst(X)', t_ops, t_wrt) 166 166 ! 167 167 ! Pression au sol 168 168 ! 169 169 CALL histdef(histid, 'ps', 'pression naturelle au sol', 'Pa', & 170 iip1, jjp1, thoriid, 1, 1, 1, -99, &171 32, 'inst(X)', t_ops, t_wrt)170 iip1, jjp1, thoriid, 1, 1, 1, -99, & 171 32, 'inst(X)', t_ops, t_wrt) 172 172 ! 173 173 ! Geopotentiel au sol -
LMDZ6/branches/Amaury_dev/libf/dyn3d_common/interpre.f90
r5113 r5114 1 2 1 ! $Id$ 3 2 4 SUBROUTINE interpre(q,qppm,w,fluxwppm,masse, &5 apppm,bpppm,massebx,masseby,pbaru,pbarv, &6 unatppm,vnatppm,psppm)3 SUBROUTINE interpre(q, qppm, w, fluxwppm, masse, & 4 apppm, bpppm, massebx, masseby, pbaru, pbarv, & 5 unatppm, vnatppm, psppm) 7 6 8 7 USE comconst_mod, ONLY: g 9 8 USE comvert_mod, ONLY: ap, bp 9 USE lmdz_description, ONLY: descript 10 10 11 11 IMPLICIT NONE 12 12 13 13 include "dimensions.h" … … 15 15 include "comdissip.h" 16 16 include "comgeom2.h" 17 include "description.h"18 17 19 18 !--------------------------------------------------- 20 19 ! Arguments 21 real :: apppm(llm +1),bpppm(llm+1)22 real :: q(iip1, jjp1,llm),qppm(iim,jjp1,llm)20 real :: apppm(llm + 1), bpppm(llm + 1) 21 real :: q(iip1, jjp1, llm), qppm(iim, jjp1, llm) 23 22 !--------------------------------------------------- 24 real :: masse(iip1, jjp1,llm)25 real :: massebx(iip1, jjp1,llm),masseby(iip1,jjm,llm)26 real :: w(iip1, jjp1,llm)27 real :: fluxwppm(iim, jjp1,llm)28 real :: pbaru(iip1, jjp1,llm)29 real :: pbarv(iip1, jjm,llm)30 real :: unatppm(iim, jjp1,llm)31 real :: vnatppm(iim, jjp1,llm)32 real :: psppm(iim, jjp1)23 real :: masse(iip1, jjp1, llm) 24 real :: massebx(iip1, jjp1, llm), masseby(iip1, jjm, llm) 25 real :: w(iip1, jjp1, llm) 26 real :: fluxwppm(iim, jjp1, llm) 27 real :: pbaru(iip1, jjp1, llm) 28 real :: pbarv(iip1, jjm, llm) 29 real :: unatppm(iim, jjp1, llm) 30 real :: vnatppm(iim, jjp1, llm) 31 real :: psppm(iim, jjp1) 33 32 !--------------------------------------------------- 34 33 ! Local 35 real :: vnat(iip1, jjp1,llm)36 real :: unat(iip1, jjp1,llm)37 real :: fluxw(iip1, jjp1,llm)38 real :: smass(iip1, jjp1)34 real :: vnat(iip1, jjp1, llm) 35 real :: unat(iip1, jjp1, llm) 36 real :: fluxw(iip1, jjp1, llm) 37 real :: smass(iip1, jjp1) 39 38 !---------------------------------------------------- 40 integer :: l, ij,i,j39 integer :: l, ij, i, j 41 40 42 43 44 45 41 ! CALCUL DE LA PRESSION DE SURFACE 42 ! Les coefficients ap et bp sont passés en common 43 ! Calcul de la pression au sol en mb optimisée pour 44 ! la vectorialisation 46 45 47 do j=1,jjp148 do i=1,iip149 smass(i,j)=0.50 51 46 do j = 1, jjp1 47 do i = 1, iip1 48 smass(i, j) = 0. 49 enddo 50 enddo 52 51 53 do l=1,llm54 do j=1,jjp155 do i=1,iip156 smass(i,j)=smass(i,j)+masse(i,j,l)57 58 59 52 do l = 1, llm 53 do j = 1, jjp1 54 do i = 1, iip1 55 smass(i, j) = smass(i, j) + masse(i, j, l) 56 enddo 57 enddo 58 enddo 60 59 61 do j=1,jjp162 do i=1,iim63 psppm(i,j)=smass(i,j)/aire(i,j)*g*0.0164 65 60 do j = 1, jjp1 61 do i = 1, iim 62 psppm(i, j) = smass(i, j) / aire(i, j) * g * 0.01 63 END DO 64 END DO 66 65 67 66 ! RECONSTRUCTION DES CHAMPS CONTRAVARIANTS … … 69 68 ! de vitesse et pas les flux, on doit donc passer de l'un à l'autre 70 69 ! Dans le même temps, on fait le changement d'orientation du vent en v 71 do l=1,llm 72 do j=1,jjm 73 do i=1,iip1 74 vnat(i,j,l)=-pbarv(i,j,l)/masseby(i,j,l)*cv(i,j) 75 enddo 70 do l = 1, llm 71 do j = 1, jjm 72 do i = 1, iip1 73 vnat(i, j, l) = -pbarv(i, j, l) / masseby(i, j, l) * cv(i, j) 76 74 enddo 77 do i=1,iim 78 vnat(i,jjp1,l)=0. 75 enddo 76 do i = 1, iim 77 vnat(i, jjp1, l) = 0. 78 enddo 79 do j = 1, jjp1 80 do i = 1, iip1 81 unat(i, j, l) = pbaru(i, j, l) / massebx(i, j, l) * cu(i, j) 79 82 enddo 80 do j=1,jjp1 81 do i=1,iip1 82 unat(i,j,l)=pbaru(i,j,l)/massebx(i,j,l)*cu(i,j) 83 enddo 84 enddo 83 enddo 85 84 enddo 86 85 87 86 ! CALCUL DU FLUX MASSIQUE VERTICAL 88 87 ! Flux en l=1 (sol) nul 89 fluxw =0.90 do l =1,llm91 do j=1,jjp192 do i=1,iip193 fluxw(i,j,l)=w(i,j,l)*g*0.01/aire(i,j)94 95 ! c 'w(i,j,l)=',w(i,j,l)96 97 88 fluxw = 0. 89 do l = 1, llm 90 do j = 1, jjp1 91 do i = 1, iip1 92 fluxw(i, j, l) = w(i, j, l) * g * 0.01 / aire(i, j) 93 ! PRINT*,i,j,l,'fluxw(i,j,l)=',fluxw(i,j,l), 94 ! c 'w(i,j,l)=',w(i,j,l) 95 enddo 96 enddo 98 97 enddo 99 98 … … 103 102 ! On passe donc des niveaux du LMDZ à ceux de Lin 104 103 105 do l =1,llm+1106 apppm(l)=ap(llm+2-l)107 bpppm(l)=bp(llm+2-l)104 do l = 1, llm + 1 105 apppm(l) = ap(llm + 2 - l) 106 bpppm(l) = bp(llm + 2 - l) 108 107 enddo 109 108 110 do l=1,llm 111 do j=1,jjp1 112 do i=1,iim 113 unatppm(i,j,l)=unat(i,j,llm-l+1) 114 vnatppm(i,j,l)=vnat(i,j,llm-l+1) 115 fluxwppm(i,j,l)=fluxw(i,j,llm-l+1) 116 qppm(i,j,l)=q(i,j,llm-l+1) 117 enddo 109 do l = 1, llm 110 do j = 1, jjp1 111 do i = 1, iim 112 unatppm(i, j, l) = unat(i, j, llm - l + 1) 113 vnatppm(i, j, l) = vnat(i, j, llm - l + 1) 114 fluxwppm(i, j, l) = fluxw(i, j, llm - l + 1) 115 qppm(i, j, l) = q(i, j, llm - l + 1) 118 116 enddo 117 enddo 119 118 enddo 120 119 -
LMDZ6/branches/Amaury_dev/libf/dyn3d_common/invert_zoom_x_m.F90
r5113 r5114 9 9 SUBROUTINE invert_zoom_x(xf, xtild, Xprimt, xlon, xprimm, xuv) 10 10 11 use coefpoly_m, only: coefpoly11 use lmdz_coefpoly, only: coefpoly 12 12 use nrtype, only: pi, pi_d, twopi_d, k8 13 13 use serre_mod, only: clon -
LMDZ6/branches/Amaury_dev/libf/dyn3d_common/traceurpole.f90
r5113 r5114 1 2 1 ! $Id$ 3 2 4 SUBROUTINE traceurpole(q,masse)5 6 3 SUBROUTINE traceurpole(q, masse) 4 USE lmdz_description, ONLY: descript 5 IMPLICIT NONE 7 6 8 7 include "dimensions.h" … … 10 9 include "comdissip.h" 11 10 include "comgeom2.h" 12 include "description.h"13 11 14 12 15 13 ! Arguments 16 17 real :: masse(iip1,jjp1,llm)18 real :: q(iip1,jjp1,llm)14 integer :: iq 15 real :: masse(iip1, jjp1, llm) 16 real :: q(iip1, jjp1, llm) 19 17 20 18 21 19 ! Locals 22 integer :: i, j,l20 integer :: i, j, l 23 21 real :: sommemassen(llm) 24 22 real :: sommemqn(llm) 25 23 real :: sommemasses(llm) 26 24 real :: sommemqs(llm) 27 real :: qpolen(llm), qpoles(llm)25 real :: qpolen(llm), qpoles(llm) 28 26 29 27 30 28 ! On impose une seule valeur au pôle Sud j=jjm+1=jjp1 31 sommemasses =032 sommemqs =033 do l=1,llm34 do i=1,iip135 sommemasses(l)=sommemasses(l)+masse(i,jjp1,l)36 sommemqs(l)=sommemqs(l)+masse(i,jjp1,l)*q(i,jjp1,l)37 38 qpoles(l)=sommemqs(l)/sommemasses(l)39 29 sommemasses = 0 30 sommemqs = 0 31 do l = 1, llm 32 do i = 1, iip1 33 sommemasses(l) = sommemasses(l) + masse(i, jjp1, l) 34 sommemqs(l) = sommemqs(l) + masse(i, jjp1, l) * q(i, jjp1, l) 35 enddo 36 qpoles(l) = sommemqs(l) / sommemasses(l) 37 enddo 40 38 41 39 ! On impose une seule valeur du traceur au pôle Nord j=1 42 sommemassen =043 sommemqn =044 do l=1,llm45 do i=1,iip146 sommemassen(l)=sommemassen(l)+masse(i,1,l)47 sommemqn(l)=sommemqn(l)+masse(i,1,l)*q(i,1,l)48 49 qpolen(l)=sommemqn(l)/sommemassen(l)50 40 sommemassen = 0 41 sommemqn = 0 42 do l = 1, llm 43 do i = 1, iip1 44 sommemassen(l) = sommemassen(l) + masse(i, 1, l) 45 sommemqn(l) = sommemqn(l) + masse(i, 1, l) * q(i, 1, l) 46 enddo 47 qpolen(l) = sommemqn(l) / sommemassen(l) 48 enddo 51 49 52 50 ! On force le traceur à prendre cette valeur aux pôles 53 do l=1,llm 54 do i=1,iip1 55 q(i,1,l)=qpolen(l) 56 q(i,jjp1,l)=qpoles(l) 57 enddo 51 do l = 1, llm 52 do i = 1, iip1 53 q(i, 1, l) = qpolen(l) 54 q(i, jjp1, l) = qpoles(l) 58 55 enddo 59 56 enddo 60 57 61 58 return -
LMDZ6/branches/Amaury_dev/libf/dyn3d_common/writedynav.F90
r5113 r5114 8 8 USE comconst_mod, ONLY: cpp 9 9 USE temps_mod, ONLY: itau_dyn 10 USE lmdz_description, ONLY: descript 10 11 11 12 IMPLICIT NONE … … 32 33 include "paramet.h" 33 34 include "comgeom.h" 34 include "description.h"35 35 include "iniprint.h" 36 36 … … 42 42 REAL phis(ip1jmp1) 43 43 REAL q(ip1jmp1, llm, nqtot) 44 integertime44 INTEGER time 45 45 46 46 ! This routine needs IOIPSL to work -
LMDZ6/branches/Amaury_dev/libf/dyn3d_common/writehist.f90
r5113 r5114 1 2 1 ! $Id$ 3 2 4 SUBROUTINE writehist(time, vcov,ucov,teta,phi,q,masse,ps,phis)3 SUBROUTINE writehist(time, vcov, ucov, teta, phi, q, masse, ps, phis) 5 4 6 5 USE ioipsl 7 6 USE infotrac, ONLY: nqtot 8 use com_io_dyn_mod, ONLY: histid,histvid,histuid7 USE com_io_dyn_mod, ONLY: histid, histvid, histuid 9 8 USE temps_mod, ONLY: itau_dyn 9 USE lmdz_description, ONLY: descript 10 10 11 11 IMPLICIT NONE … … 36 36 include "paramet.h" 37 37 include "comgeom.h" 38 include "description.h"39 38 include "iniprint.h" 40 39 … … 43 42 ! 44 43 45 REAL :: vcov(ip1jm, llm),ucov(ip1jmp1,llm)46 REAL :: teta(ip1jmp1, llm),phi(ip1jmp1,llm)47 REAL :: ps(ip1jmp1), masse(ip1jmp1,llm)44 REAL :: vcov(ip1jm, llm), ucov(ip1jmp1, llm) 45 REAL :: teta(ip1jmp1, llm), phi(ip1jmp1, llm) 46 REAL :: ps(ip1jmp1), masse(ip1jmp1, llm) 48 47 REAL :: phis(ip1jmp1) 49 REAL :: q(ip1jmp1, llm,nqtot)48 REAL :: q(ip1jmp1, llm, nqtot) 50 49 integer :: time 51 50 … … 55 54 ! 56 55 integer :: iq, ii, ll 57 integer :: ndexu(ip1jmp1 *llm),ndexv(ip1jm*llm),ndex2d(ip1jmp1)56 integer :: ndexu(ip1jmp1 * llm), ndexv(ip1jm * llm), ndex2d(ip1jmp1) 58 57 logical :: ok_sync 59 58 integer :: itau_w 60 REAL :: vnat(ip1jm, llm),unat(ip1jmp1,llm)59 REAL :: vnat(ip1jm, llm), unat(ip1jmp1, llm) 61 60 62 61 ! … … 66 65 ndexv = 0 67 66 ndex2d = 0 68 ok_sync = .TRUE.67 ok_sync = .TRUE. 69 68 itau_w = itau_dyn + time 70 69 ! Passage aux composantes naturelles du vent … … 76 75 ! 77 76 CALL histwrite(histuid, 'u', itau_w, unat, & 78 iip1*jjp1*llm, ndexu)77 iip1 * jjp1 * llm, ndexu) 79 78 ! 80 79 ! Vents V 81 80 ! 82 81 CALL histwrite(histvid, 'v', itau_w, vnat, & 83 iip1*jjm*llm, ndexv)82 iip1 * jjm * llm, ndexv) 84 83 85 84 ! … … 87 86 ! 88 87 CALL histwrite(histid, 'teta', itau_w, teta, & 89 iip1*jjp1*llm, ndexu)88 iip1 * jjp1 * llm, ndexu) 90 89 ! 91 90 ! Geopotentiel 92 91 ! 93 92 CALL histwrite(histid, 'phi', itau_w, phi, & 94 iip1*jjp1*llm, ndexu)93 iip1 * jjp1 * llm, ndexu) 95 94 ! 96 95 ! Traceurs … … 103 102 ! Masse 104 103 ! 105 CALL histwrite(histid, 'masse',itau_w, masse,iip1*jjp1*llm,ndexu)104 CALL histwrite(histid, 'masse', itau_w, masse, iip1 * jjp1 * llm, ndexu) 106 105 ! 107 106 ! Pression au sol 108 107 ! 109 CALL histwrite(histid, 'ps', itau_w, ps, iip1 *jjp1, ndex2d)108 CALL histwrite(histid, 'ps', itau_w, ps, iip1 * jjp1, ndex2d) 110 109 ! 111 110 ! Geopotentiel au sol -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/advtrac_loc.f90
r5103 r5114 19 19 USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_DEBUGIO 20 20 USE strings_mod, ONLY: int2str 21 USE lmdz_description, ONLY: descript 21 22 22 23 IMPLICIT NONE … … 26 27 include "comdissip.h" 27 28 include "comgeom2.h" 28 include "description.h"29 ! include "iniprint.h"30 29 31 30 !--------------------------------------------------------------------------- -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dynetat0_loc.F90
r5113 r5114 21 21 USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0 22 22 USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA 23 USE lmdz_description, ONLY: descript 23 24 24 25 IMPLICIT NONE … … 26 27 include "paramet.h" 27 28 include "comgeom.h" 28 include "description.h"29 29 include "iniprint.h" 30 30 !=============================================================================== -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dynredem_loc.F90
r5103 r5114 21 21 USE temps_mod, ONLY: annee_ref, day_ref, itau_dyn, itaufin, start_time 22 22 USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0 23 USE lmdz_description, ONLY: descript 23 24 24 25 IMPLICIT NONE … … 26 27 include "paramet.h" 27 28 include "comgeom.h" 28 include "description.h"29 29 include "iniprint.h" 30 30 !=============================================================================== … … 174 174 err, modname, fil, msg 175 175 USE temps_mod, ONLY: itau_dyn, itaufin 176 USE lmdz_description, ONLY: descript 176 177 177 178 IMPLICIT NONE 178 179 include "dimensions.h" 179 180 include "paramet.h" 180 include "description.h"181 181 include "comgeom.h" 182 182 include "iniprint.h" -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/gcm.F90
r5106 r5114 25 25 USE mod_xios_dyn3dmem, ONLY: xios_dyn3dmem_init 26 26 USE lmdz_filtreg, ONLY: inifilr 27 USE lmdz_description, ONLY: descript 27 28 28 29 IMPLICIT NONE … … 61 62 include "comdissnew.h" 62 63 include "comgeom.h" 63 include "description.h"64 64 include "iniprint.h" 65 65 include "tracstoke.h" -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/initdynav_loc.f90
r5113 r5114 15 15 USE comvert_mod, ONLY: presnivs 16 16 USE temps_mod, ONLY: itau_dyn 17 USE lmdz_description, ONLY: descript 17 18 18 19 IMPLICIT NONE … … 46 47 include "paramet.h" 47 48 include "comgeom.h" 48 include "description.h"49 49 include "iniprint.h" 50 50 -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/initfluxsto_p.f90
r5113 r5114 1 2 1 ! $Id$ 3 2 4 SUBROUTINE initfluxsto_p & 5 (infile,tstep,t_ops,t_wrt, & 6 fileid,filevid,filedid) 7 8 ! This routine needs IOIPSL 9 USE IOIPSL 10 USE parallel_lmdz 11 use Write_field 12 use misc_mod 13 USE comconst_mod, ONLY: pi 14 USE comvert_mod, ONLY: nivsigs 15 USE temps_mod, ONLY: annee_ref, day_ref, itau_dyn 3 SUBROUTINE initfluxsto_p(infile, tstep, t_ops, t_wrt, fileid, filevid, filedid) 4 USE IOIPSL 5 USE parallel_lmdz 6 use Write_field 7 use misc_mod 8 USE comconst_mod, ONLY: pi 9 USE comvert_mod, ONLY: nivsigs 10 USE temps_mod, ONLY: annee_ref, day_ref, itau_dyn 11 USE lmdz_description, ONLY: descript 16 12 17 13 IMPLICIT NONE … … 47 43 include "paramet.h" 48 44 include "comgeom.h" 49 include "description.h"50 45 include "iniprint.h" 51 46 52 47 ! Arguments 53 48 ! 54 character(len =*) :: infile49 character(len = *) :: infile 55 50 real :: tstep, t_ops, t_wrt 56 integer :: fileid, filevid, filedid51 integer :: fileid, filevid, filedid 57 52 58 53 ! This routine needs IOIPSL … … 62 57 integer :: tau0 63 58 real :: zjulian 64 character(len =3) :: str65 character(len =10) :: ctrac59 character(len = 3) :: str 60 character(len = 10) :: ctrac 66 61 integer :: iq 67 real :: rlong(iip1, jjp1), rlat(iip1,jjp1),rl(1,1)68 integer :: uhoriid, vhoriid, thoriid, zvertiid, dhoriid,dvertiid69 integer :: ii, jj62 real :: rlong(iip1, jjp1), rlat(iip1, jjp1), rl(1, 1) 63 integer :: uhoriid, vhoriid, thoriid, zvertiid, dhoriid, dvertiid 64 integer :: ii, jj 70 65 integer :: zan, idayref 71 66 logical :: ok_sync 72 integer :: jjb, jje,jjn67 integer :: jjb, jje, jjn 73 68 74 69 ! definition du domaine d'ecriture pour le rebuild 75 70 76 INTEGER, DIMENSION(2) :: ddid77 INTEGER, DIMENSION(2) :: dsg78 INTEGER, DIMENSION(2) :: dsl79 INTEGER, DIMENSION(2) :: dpf80 INTEGER, DIMENSION(2) :: dpl81 INTEGER, DIMENSION(2) :: dhs82 INTEGER, DIMENSION(2) :: dhe71 INTEGER, DIMENSION(2) :: ddid 72 INTEGER, DIMENSION(2) :: dsg 73 INTEGER, DIMENSION(2) :: dsl 74 INTEGER, DIMENSION(2) :: dpf 75 INTEGER, DIMENSION(2) :: dpl 76 INTEGER, DIMENSION(2) :: dhs 77 INTEGER, DIMENSION(2) :: dhe 83 78 84 79 INTEGER :: dynu_domain_id … … 89 84 ! 90 85 pi = 4. * atan (1.) 91 str ='q '86 str = 'q ' 92 87 ctrac = 'traceur ' 93 88 ok_sync = .TRUE. … … 101 96 tau0 = itau_dyn 102 97 103 98 do jj = 1, jjp1 104 99 do ii = 1, iip1 105 rlong(ii, jj) = rlonu(ii) * 180. / pi106 rlat(ii, jj) = rlatu(jj) * 180. / pi100 rlong(ii, jj) = rlonu(ii) * 180. / pi 101 rlat(ii, jj) = rlatu(jj) * 180. / pi 107 102 enddo 108 103 enddo 109 104 110 jjb =jj_begin111 jje =jj_end112 jjn =jj_nb113 114 ddid =(/ 1,2 /)115 dsg =(/ iip1,jjp1 /)116 dsl =(/ iip1,jjn /)117 dpf =(/ 1,jjb /)118 dpl =(/ iip1,jje /)119 dhs =(/ 0,0 /)120 dhe =(/ 0,0 /)121 122 CALL flio_dom_set(mpi_size, mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &123 'box',dynu_domain_id)124 125 CALL histbeg(trim(infile), iip1, rlong(:,1), jjn, rlat(1,jjb:jje), &126 1, iip1, 1, jjn, tau0, zjulian, tstep, uhoriid, &127 fileid,dynu_domain_id)105 jjb = jj_begin 106 jje = jj_end 107 jjn = jj_nb 108 109 ddid = (/ 1, 2 /) 110 dsg = (/ iip1, jjp1 /) 111 dsl = (/ iip1, jjn /) 112 dpf = (/ 1, jjb /) 113 dpl = (/ iip1, jje /) 114 dhs = (/ 0, 0 /) 115 dhe = (/ 0, 0 /) 116 117 CALL flio_dom_set(mpi_size, mpi_rank, ddid, dsg, dsl, dpf, dpl, dhs, dhe, & 118 'box', dynu_domain_id) 119 120 CALL histbeg(trim(infile), iip1, rlong(:, 1), jjn, rlat(1, jjb:jje), & 121 1, iip1, 1, jjn, tau0, zjulian, tstep, uhoriid, & 122 fileid, dynu_domain_id) 128 123 ! 129 124 ! Creation du fichier histoire pour la grille en V (oblige pour l'instant, … … 131 126 ! un meme fichier) 132 127 133 134 128 do jj = 1, jjm 135 129 do ii = 1, iip1 136 rlong(ii, jj) = rlonv(ii) * 180. / pi137 rlat(ii, jj) = rlatv(jj) * 180. / pi130 rlong(ii, jj) = rlonv(ii) * 180. / pi 131 rlat(ii, jj) = rlatv(jj) * 180. / pi 138 132 enddo 139 133 enddo 140 134 141 jjb =jj_begin142 jje =jj_end143 jjn =jj_nb144 if (pole_sud) jje =jj_end-1145 if (pole_sud) jjn =jj_nb-1146 147 ddid =(/ 1,2 /)148 dsg =(/ iip1,jjm /)149 dsl =(/ iip1,jjn /)150 dpf =(/ 1,jjb /)151 dpl =(/ iip1,jje /)152 dhs =(/ 0,0 /)153 dhe =(/ 0,0 /)154 155 CALL flio_dom_set(mpi_size, mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &156 'box',dynv_domain_id)157 158 CALL histbeg('fluxstokev', iip1, rlong(:,1), jjn, rlat(1,jjb:jje), &159 1, iip1, 1, jjn,tau0, zjulian, tstep, vhoriid, &160 filevid,dynv_domain_id)161 162 rl(1, 1) = 1.135 jjb = jj_begin 136 jje = jj_end 137 jjn = jj_nb 138 if (pole_sud) jje = jj_end - 1 139 if (pole_sud) jjn = jj_nb - 1 140 141 ddid = (/ 1, 2 /) 142 dsg = (/ iip1, jjm /) 143 dsl = (/ iip1, jjn /) 144 dpf = (/ 1, jjb /) 145 dpl = (/ iip1, jje /) 146 dhs = (/ 0, 0 /) 147 dhe = (/ 0, 0 /) 148 149 CALL flio_dom_set(mpi_size, mpi_rank, ddid, dsg, dsl, dpf, dpl, dhs, dhe, & 150 'box', dynv_domain_id) 151 152 CALL histbeg('fluxstokev', iip1, rlong(:, 1), jjn, rlat(1, jjb:jje), & 153 1, iip1, 1, jjn, tau0, zjulian, tstep, vhoriid, & 154 filevid, dynv_domain_id) 155 156 rl(1, 1) = 1. 163 157 164 158 if (mpi_rank==0) then 165 159 166 160 CALL histbeg('defstoke.nc', 1, rl, 1, rl, & 167 1, 1, 1, 1, &168 tau0, zjulian, tstep, dhoriid, filedid)161 1, 1, 1, 1, & 162 tau0, zjulian, tstep, dhoriid, filedid) 169 163 170 164 endif … … 174 168 do jj = 1, jjp1 175 169 do ii = 1, iip1 176 rlong(ii, jj) = rlonv(ii) * 180. / pi177 rlat(ii, jj) = rlatu(jj) * 180. / pi170 rlong(ii, jj) = rlonv(ii) * 180. / pi 171 rlat(ii, jj) = rlatu(jj) * 180. / pi 178 172 enddo 179 173 enddo 180 174 181 jjb =jj_begin182 jje =jj_end183 jjn =jj_nb184 185 CALL histhori(fileid, iip1, rlong(:, jjb:jje),jjn,rlat(:,jjb:jje), &186 'scalar','Grille points scalaires', thoriid)175 jjb = jj_begin 176 jje = jj_end 177 jjn = jj_nb 178 179 CALL histhori(fileid, iip1, rlong(:, jjb:jje), jjn, rlat(:, jjb:jje), & 180 'scalar', 'Grille points scalaires', thoriid) 187 181 188 182 ! … … 190 184 ! 191 185 CALL histvert(fileid, 'sig_s', 'Niveaux sigma', & 192 'sigma_level', &193 llm, nivsigs, zvertiid)186 'sigma_level', & 187 llm, nivsigs, zvertiid) 194 188 ! Pour le fichier V 195 189 CALL histvert(filevid, 'sig_s', 'Niveaux sigma', & 196 'sigma_level', &197 llm, nivsigs, zvertiid)190 'sigma_level', & 191 llm, nivsigs, zvertiid) 198 192 ! pour le fichier def 199 193 if (mpi_rank==0) then 200 201 202 'sigma_level', &203 1, nivd, dvertiid)194 nivd(1) = 1 195 CALL histvert(filedid, 'sig_s', 'Niveaux sigma', & 196 'sigma_level', & 197 1, nivd, dvertiid) 204 198 endif 205 199 ! 206 200 ! Appels a histdef pour la definition des variables a sauvegarder 207 201 208 209 iip1, jjn,thoriid, 1,1,1, -99, 32, &202 CALL histdef(fileid, "phis", "Surface geop. height", "-", & 203 iip1, jjn, thoriid, 1, 1, 1, -99, 32, & 210 204 "once", t_ops, t_wrt) 211 205 212 213 iip1,jjn,thoriid, 1,1,1, -99, 32, &214 215 216 206 CALL histdef(fileid, "aire", "Grid area", "-", & 207 iip1, jjn, thoriid, 1, 1, 1, -99, 32, & 208 "once", t_ops, t_wrt) 209 210 if (mpi_rank==0) then 217 211 218 212 CALL histdef(filedid, "dtvr", "tps dyn", "s", & 219 1,1,dhoriid, 1,1,1, -99, 32, &220 "once", t_ops, t_wrt)221 222 223 1,1,dhoriid, 1,1,1, -99, 32, &224 "once", t_ops, t_wrt)225 226 227 1,1,dhoriid, 1,1,1, -99, 32, &228 "once", t_ops, t_wrt)229 230 213 1, 1, dhoriid, 1, 1, 1, -99, 32, & 214 "once", t_ops, t_wrt) 215 216 CALL histdef(filedid, "istdyn", "tps stock", "s", & 217 1, 1, dhoriid, 1, 1, 1, -99, 32, & 218 "once", t_ops, t_wrt) 219 220 CALL histdef(filedid, "istphy", "tps stock phy", "s", & 221 1, 1, dhoriid, 1, 1, 1, -99, 32, & 222 "once", t_ops, t_wrt) 223 224 endif 231 225 ! 232 226 ! Masse 233 227 ! 234 228 CALL histdef(fileid, 'masse', 'Masse', 'kg', & 235 iip1, jjn, thoriid, llm, 1, llm, zvertiid, &236 32, 'inst(X)', t_ops, t_wrt)229 iip1, jjn, thoriid, llm, 1, llm, zvertiid, & 230 32, 'inst(X)', t_ops, t_wrt) 237 231 ! 238 232 ! Pbaru 239 233 ! 240 234 CALL histdef(fileid, 'pbaru', 'flx de masse zonal', 'kg m/s', & 241 iip1, jjn, uhoriid, llm, 1, llm, zvertiid, &242 32, 'inst(X)', t_ops, t_wrt)235 iip1, jjn, uhoriid, llm, 1, llm, zvertiid, & 236 32, 'inst(X)', t_ops, t_wrt) 243 237 244 238 ! 245 239 ! Pbarv 246 240 ! 247 if (pole_sud) jjn =jj_nb-1241 if (pole_sud) jjn = jj_nb - 1 248 242 249 243 CALL histdef(filevid, 'pbarv', 'flx de masse mer', 'kg m/s', & 250 iip1, jjn, vhoriid, llm, 1, llm, zvertiid, &251 32, 'inst(X)', t_ops, t_wrt)244 iip1, jjn, vhoriid, llm, 1, llm, zvertiid, & 245 32, 'inst(X)', t_ops, t_wrt) 252 246 ! 253 247 ! w 254 248 ! 255 if (pole_sud) jjn =jj_nb249 if (pole_sud) jjn = jj_nb 256 250 CALL histdef(fileid, 'w', 'flx de masse vert', 'kg m/s', & 257 iip1, jjn, thoriid, llm, 1, llm, zvertiid, &258 32, 'inst(X)', t_ops, t_wrt)251 iip1, jjn, thoriid, llm, 1, llm, zvertiid, & 252 32, 'inst(X)', t_ops, t_wrt) 259 253 260 254 ! … … 262 256 ! 263 257 CALL histdef(fileid, 'teta', 'temperature potentielle', '-', & 264 iip1, jjn, thoriid, llm, 1, llm, zvertiid, &265 32, 'inst(X)', t_ops, t_wrt)258 iip1, jjn, thoriid, llm, 1, llm, zvertiid, & 259 32, 'inst(X)', t_ops, t_wrt) 266 260 ! 267 261 … … 270 264 ! 271 265 CALL histdef(fileid, 'phi', 'geopotentiel instantane', '-', & 272 iip1, jjn, thoriid, llm, 1, llm, zvertiid, &273 32, 'inst(X)', t_ops, t_wrt)266 iip1, jjn, thoriid, llm, 1, llm, zvertiid, & 267 32, 'inst(X)', t_ops, t_wrt) 274 268 ! 275 269 ! Fin … … 284 278 endif 285 279 286 287 280 end subroutine initfluxsto_p -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/inithist_loc.F90
r5113 r5114 4 4 5 5 ! This routine needs IOIPSL 6 6 USE IOIPSL 7 7 USE parallel_lmdz 8 useWrite_field9 usemisc_mod10 usecom_io_dyn_mod, ONLY: histid, histvid, histuid, &8 USE Write_field 9 USE misc_mod 10 USE com_io_dyn_mod, ONLY: histid, histvid, histuid, & 11 11 dynhist_file, dynhistv_file, dynhistu_file 12 12 USE comconst_mod, ONLY: pi 13 13 USE comvert_mod, ONLY: presnivs 14 14 USE temps_mod, ONLY: itau_dyn 15 USE lmdz_description, ONLY: descript 15 16 16 17 IMPLICIT NONE … … 43 44 include "paramet.h" 44 45 include "comgeom.h" 45 include "description.h"46 46 include "iniprint.h" 47 47 … … 57 57 real :: zjulian 58 58 integer :: iq 59 real :: rlong(iip1, jjp1), rlat(iip1,jjp1)59 real :: rlong(iip1, jjp1), rlat(iip1, jjp1) 60 60 integer :: uhoriid, vhoriid, thoriid 61 integer :: zvertiid, zvertiidv,zvertiidu62 integer :: ii, jj61 integer :: zvertiid, zvertiidv, zvertiidu 62 integer :: ii, jj 63 63 integer :: zan, dayref 64 integer :: jjb, jje,jjn64 integer :: jjb, jje, jjn 65 65 66 66 ! definition du domaine d'ecriture pour le rebuild 67 67 68 INTEGER, DIMENSION(2) :: ddid69 INTEGER, DIMENSION(2) :: dsg70 INTEGER, DIMENSION(2) :: dsl71 INTEGER, DIMENSION(2) :: dpf72 INTEGER, DIMENSION(2) :: dpl73 INTEGER, DIMENSION(2) :: dhs74 INTEGER, DIMENSION(2) :: dhe68 INTEGER, DIMENSION(2) :: ddid 69 INTEGER, DIMENSION(2) :: dsg 70 INTEGER, DIMENSION(2) :: dsl 71 INTEGER, DIMENSION(2) :: dpf 72 INTEGER, DIMENSION(2) :: dpl 73 INTEGER, DIMENSION(2) :: dhs 74 INTEGER, DIMENSION(2) :: dhe 75 75 76 76 INTEGER :: dynhist_domain_id … … 95 95 do jj = 1, jjp1 96 96 do ii = 1, iip1 97 rlong(ii, jj) = rlonv(ii) * 180. / pi98 rlat(ii, jj)= rlatu(jj) * 180. / pi97 rlong(ii, jj) = rlonv(ii) * 180. / pi 98 rlat(ii, jj) = rlatu(jj) * 180. / pi 99 99 enddo 100 100 enddo … … 105 105 ! Grille Scalaire 106 106 107 jjb=jj_begin 108 jje=jj_end 109 jjn=jj_nb 110 111 ddid=(/ 1,2 /) 112 dsg=(/ iip1,jjp1 /) 113 dsl=(/ iip1,jjn /) 114 dpf=(/ 1,jjb /) 115 dpl=(/ iip1,jje /) 116 dhs=(/ 0,0 /) 117 dhe=(/ 0,0 /) 118 119 120 CALL flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, & 121 'box',dynhist_domain_id) 122 123 CALL histbeg(dynhist_file,iip1, rlong(:,1), jjn, & 124 rlat(1,jjb:jje), 1, iip1, 1, jjn,tau0, & 125 zjulian, tstep, thoriid, & 126 histid,dynhist_domain_id) 107 jjb = jj_begin 108 jje = jj_end 109 jjn = jj_nb 110 111 ddid = (/ 1, 2 /) 112 dsg = (/ iip1, jjp1 /) 113 dsl = (/ iip1, jjn /) 114 dpf = (/ 1, jjb /) 115 dpl = (/ iip1, jje /) 116 dhs = (/ 0, 0 /) 117 dhe = (/ 0, 0 /) 118 119 CALL flio_dom_set(mpi_size, mpi_rank, ddid, dsg, dsl, dpf, dpl, dhs, dhe, & 120 'box', dynhist_domain_id) 121 122 CALL histbeg(dynhist_file, iip1, rlong(:, 1), jjn, & 123 rlat(1, jjb:jje), 1, iip1, 1, jjn, tau0, & 124 zjulian, tstep, thoriid, & 125 histid, dynhist_domain_id) 127 126 128 127 … … 132 131 ! Grille V 133 132 134 jjb =jj_begin135 jje =jj_end136 jjn =jj_nb137 IF (pole_sud) jjn =jjn-1138 IF (pole_sud) jje =jje-1133 jjb = jj_begin 134 jje = jj_end 135 jjn = jj_nb 136 IF (pole_sud) jjn = jjn - 1 137 IF (pole_sud) jje = jje - 1 139 138 140 139 do jj = jjb, jje 141 140 do ii = 1, iip1 142 rlong(ii, jj) = rlonv(ii) * 180. / pi143 rlat(ii, jj) = rlatv(jj) * 180. / pi141 rlong(ii, jj) = rlonv(ii) * 180. / pi 142 rlat(ii, jj) = rlatv(jj) * 180. / pi 144 143 enddo 145 144 enddo 146 145 147 ddid=(/ 1,2 /) 148 dsg=(/ iip1,jjm /) 149 dsl=(/ iip1,jjn /) 150 dpf=(/ 1,jjb /) 151 dpl=(/ iip1,jje /) 152 dhs=(/ 0,0 /) 153 dhe=(/ 0,0 /) 154 155 156 CALL flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, & 157 'box',dynhistv_domain_id) 158 159 CALL histbeg(dynhistv_file,iip1, rlong(:,1), jjn, & 160 rlat(1,jjb:jje), 1, iip1, 1, jjn,tau0, & 161 zjulian, tstep, vhoriid, & 162 histvid,dynhistv_domain_id) 146 ddid = (/ 1, 2 /) 147 dsg = (/ iip1, jjm /) 148 dsl = (/ iip1, jjn /) 149 dpf = (/ 1, jjb /) 150 dpl = (/ iip1, jje /) 151 dhs = (/ 0, 0 /) 152 dhe = (/ 0, 0 /) 153 154 CALL flio_dom_set(mpi_size, mpi_rank, ddid, dsg, dsl, dpf, dpl, dhs, dhe, & 155 'box', dynhistv_domain_id) 156 157 CALL histbeg(dynhistv_file, iip1, rlong(:, 1), jjn, & 158 rlat(1, jjb:jje), 1, iip1, 1, jjn, tau0, & 159 zjulian, tstep, vhoriid, & 160 histvid, dynhistv_domain_id) 163 161 164 162 ! Grille U … … 166 164 do jj = 1, jjp1 167 165 do ii = 1, iip1 168 rlong(ii, jj) = rlonu(ii) * 180. / pi169 rlat(ii, jj) = rlatu(jj) * 180. / pi166 rlong(ii, jj) = rlonu(ii) * 180. / pi 167 rlat(ii, jj) = rlatu(jj) * 180. / pi 170 168 enddo 171 169 enddo 172 170 173 jjb=jj_begin 174 jje=jj_end 175 jjn=jj_nb 176 177 ddid=(/ 1,2 /) 178 dsg=(/ iip1,jjp1 /) 179 dsl=(/ iip1,jjn /) 180 dpf=(/ 1,jjb /) 181 dpl=(/ iip1,jje /) 182 dhs=(/ 0,0 /) 183 dhe=(/ 0,0 /) 184 185 186 CALL flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, & 187 'box',dynhistu_domain_id) 188 189 CALL histbeg(dynhistu_file,iip1, rlong(:,1), jjn, & 190 rlat(1,jjb:jje), 1, iip1, 1, jjn,tau0, & 191 zjulian, tstep, uhoriid, & 192 histuid,dynhistu_domain_id) 171 jjb = jj_begin 172 jje = jj_end 173 jjn = jj_nb 174 175 ddid = (/ 1, 2 /) 176 dsg = (/ iip1, jjp1 /) 177 dsl = (/ iip1, jjn /) 178 dpf = (/ 1, jjb /) 179 dpl = (/ iip1, jje /) 180 dhs = (/ 0, 0 /) 181 dhe = (/ 0, 0 /) 182 183 CALL flio_dom_set(mpi_size, mpi_rank, ddid, dsg, dsl, dpf, dpl, dhs, dhe, & 184 'box', dynhistu_domain_id) 185 186 CALL histbeg(dynhistu_file, iip1, rlong(:, 1), jjn, & 187 rlat(1, jjb:jje), 1, iip1, 1, jjn, tau0, & 188 zjulian, tstep, uhoriid, & 189 histuid, dynhistu_domain_id) 193 190 194 191 … … 196 193 ! Appel a histvert pour la grille verticale 197 194 ! ------------------------------------------------------------- 198 CALL histvert(histid, 'presnivs', 'Niveaux pression', 'mb', &199 llm, presnivs/100., zvertiid,'down')200 CALL histvert(histvid, 'presnivs', 'Niveaux pression', 'mb', &201 llm, presnivs/100., zvertiidv,'down')202 CALL histvert(histuid, 'presnivs', 'Niveaux pression', 'mb', &203 llm, presnivs/100., zvertiidu,'down')195 CALL histvert(histid, 'presnivs', 'Niveaux pression', 'mb', & 196 llm, presnivs / 100., zvertiid, 'down') 197 CALL histvert(histvid, 'presnivs', 'Niveaux pression', 'mb', & 198 llm, presnivs / 100., zvertiidv, 'down') 199 CALL histvert(histuid, 'presnivs', 'Niveaux pression', 'mb', & 200 llm, presnivs / 100., zvertiidu, 'down') 204 201 205 202 ! … … 210 207 ! Vents U 211 208 ! 212 jjn =jj_nb209 jjn = jj_nb 213 210 CALL histdef(histuid, 'u', 'vent u', & 214 'm/s', iip1, jjn, uhoriid, llm, 1, llm, zvertiidu, &215 32, 'inst(X)', t_ops, t_wrt)211 'm/s', iip1, jjn, uhoriid, llm, 1, llm, zvertiidu, & 212 32, 'inst(X)', t_ops, t_wrt) 216 213 217 214 ! 218 215 ! Vents V 219 216 ! 220 if (pole_sud) jjn =jj_nb-1217 if (pole_sud) jjn = jj_nb - 1 221 218 CALL histdef(histvid, 'v', 'vent v', & 222 'm/s', iip1, jjn, vhoriid, llm, 1, llm, zvertiidv, &223 32, 'inst(X)', t_ops, t_wrt)219 'm/s', iip1, jjn, vhoriid, llm, 1, llm, zvertiidv, & 220 32, 'inst(X)', t_ops, t_wrt) 224 221 225 222 ! 226 223 ! Temperature 227 224 ! 228 jjn =jj_nb225 jjn = jj_nb 229 226 CALL histdef(histid, 'temp', 'temperature', 'K', & 230 iip1, jjn, thoriid, llm, 1, llm, zvertiid, &231 32, 'inst(X)', t_ops, t_wrt)227 iip1, jjn, thoriid, llm, 1, llm, zvertiid, & 228 32, 'inst(X)', t_ops, t_wrt) 232 229 ! 233 230 ! Temperature potentielle 234 231 ! 235 232 CALL histdef(histid, 'theta', 'temperature potentielle', 'K', & 236 iip1, jjn, thoriid, llm, 1, llm, zvertiid, &237 32, 'inst(X)', t_ops, t_wrt)233 iip1, jjn, thoriid, llm, 1, llm, zvertiid, & 234 32, 'inst(X)', t_ops, t_wrt) 238 235 239 236 … … 242 239 ! 243 240 CALL histdef(histid, 'phi', 'geopotentiel', '-', & 244 iip1, jjn, thoriid, llm, 1, llm, zvertiid, &245 32, 'inst(X)', t_ops, t_wrt)241 iip1, jjn, thoriid, llm, 1, llm, zvertiid, & 242 32, 'inst(X)', t_ops, t_wrt) 246 243 ! 247 244 ! Traceurs … … 257 254 ! 258 255 CALL histdef(histid, 'masse', 'masse', 'kg', & 259 iip1, jjn, thoriid, llm, 1, llm, zvertiid, &260 32, 'inst(X)', t_ops, t_wrt)256 iip1, jjn, thoriid, llm, 1, llm, zvertiid, & 257 32, 'inst(X)', t_ops, t_wrt) 261 258 ! 262 259 ! Pression au sol 263 260 ! 264 261 CALL histdef(histid, 'ps', 'pression naturelle au sol', 'Pa', & 265 iip1, jjn, thoriid, 1, 1, 1, -99, &266 32, 'inst(X)', t_ops, t_wrt)262 iip1, jjn, thoriid, 1, 1, 1, -99, & 263 32, 'inst(X)', t_ops, t_wrt) 267 264 ! 268 265 ! Geopotentiel au sol -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/leapfrog_loc.F90
r5113 r5114 40 40 using_xios 41 41 USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_DEBUGIO 42 USE lmdz_description, ONLY: descript 42 43 43 44 IMPLICIT NONE … … 78 79 include "comdissnew.h" 79 80 include "comgeom.h" 80 include "description.h"81 81 include "iniprint.h" 82 82 include "academic.h" -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writedyn_xios.F90
r5113 r5114 1 2 1 ! $Id$ 3 2 4 SUBROUTINE writedyn_xios( vcov, ucov,teta,ppk,phi,q, &5 masse,ps,phis)3 SUBROUTINE writedyn_xios(vcov, ucov, teta, ppk, phi, q, & 4 masse, ps, phis) 6 5 7 USE lmdz_xios 8 USE parallel_lmdz 9 USE misc_mod 10 USE infotrac, ONLY: nqtot 11 use com_io_dyn_mod, ONLY: histaveid,histvaveid,histuaveid 12 USE comconst_mod, ONLY: cpp 13 USE temps_mod, ONLY: itau_dyn 14 USE mod_xios_dyn3dmem, ONLY: writefield_dyn_u, writefield_dyn_v 15 16 IMPLICIT NONE 6 USE lmdz_xios 7 USE parallel_lmdz 8 USE misc_mod 9 USE infotrac, ONLY: nqtot 10 use com_io_dyn_mod, ONLY: histaveid, histvaveid, histuaveid 11 USE comconst_mod, ONLY: cpp 12 USE temps_mod, ONLY: itau_dyn 13 USE mod_xios_dyn3dmem, ONLY: writefield_dyn_u, writefield_dyn_v 14 USE lmdz_description, ONLY: descript 17 15 18 ! Ecriture du fichier histoire au format xios 16 IMPLICIT NONE 17 18 ! Ecriture du fichier histoire au format xios 19 19 20 20 21 ! Entree:22 ! vcov: vents v covariants23 ! ucov: vents u covariants24 ! teta: temperature potentielle25 ! phi : geopotentiel instantane26 ! q : traceurs27 ! masse: masse28 ! ps :pression au sol29 ! phis : geopotentiel au sol21 ! Entree: 22 ! vcov: vents v covariants 23 ! ucov: vents u covariants 24 ! teta: temperature potentielle 25 ! phi : geopotentiel instantane 26 ! q : traceurs 27 ! masse: masse 28 ! ps :pression au sol 29 ! phis : geopotentiel au sol 30 30 31 ! L. Fairhead, LMD, 03/2131 ! L. Fairhead, LMD, 03/21 32 32 33 ! =====================================================================33 ! ===================================================================== 34 34 35 ! Declarations 36 include "dimensions.h" 37 include "paramet.h" 38 include "comgeom.h" 39 include "description.h" 40 include "iniprint.h" 35 ! Declarations 36 include "dimensions.h" 37 include "paramet.h" 38 include "comgeom.h" 39 include "iniprint.h" 41 40 42 ! Arguments41 ! Arguments 43 42 44 REAL vcov(ijb_v:ije_v,llm),ucov(ijb_u:ije_u,llm)45 REAL teta(ijb_u:ije_u,llm),phi(ijb_u:ije_u,llm)46 REAL ppk(ijb_u:ije_u,llm)47 REAL ps(ijb_u:ije_u),masse(ijb_u:ije_u,llm)48 REAL phis(ijb_u:ije_u)49 REAL q(ijb_u:ije_u,llm,nqtot)50 43 REAL vcov(ijb_v:ije_v, llm), ucov(ijb_u:ije_u, llm) 44 REAL teta(ijb_u:ije_u, llm), phi(ijb_u:ije_u, llm) 45 REAL ppk(ijb_u:ije_u, llm) 46 REAL ps(ijb_u:ije_u), masse(ijb_u:ije_u, llm) 47 REAL phis(ijb_u:ije_u) 48 REAL q(ijb_u:ije_u, llm, nqtot) 49 integer time 51 50 52 51 53 ! Variables locales52 ! Variables locales 54 53 55 INTEGER,SAVE,ALLOCATABLE :: ndex2d(:),ndexu(:),ndexv(:)56 57 REAL,SAVE,ALLOCATABLE :: tm(:,:)58 REAL,SAVE,ALLOCATABLE :: vnat(:,:),unat(:,:)59 REAL,SAVE,ALLOCATABLE :: vbuffer(:,:)60 61 62 integer :: ijb,ije,jjn63 LOGICAL,SAVE :: first=.TRUE.64 LOGICAL,SAVE :: debuglf=.TRUE.65 !$OMP THREADPRIVATE(debuglf)66 !$OMP THREADPRIVATE(first)54 INTEGER, SAVE, ALLOCATABLE :: ndex2d(:), ndexu(:), ndexv(:) 55 INTEGER :: iq, ii, ll 56 REAL, SAVE, ALLOCATABLE :: tm(:, :) 57 REAL, SAVE, ALLOCATABLE :: vnat(:, :), unat(:, :) 58 REAL, SAVE, ALLOCATABLE :: vbuffer(:, :) 59 logical ok_sync 60 integer itau_w 61 integer :: ijb, ije, jjn 62 LOGICAL, SAVE :: first = .TRUE. 63 LOGICAL, SAVE :: debuglf = .TRUE. 64 !$OMP THREADPRIVATE(debuglf) 65 !$OMP THREADPRIVATE(first) 67 66 68 ! Initialisations67 ! Initialisations 69 68 70 ! WRITE(*,*)'IN WRITEDYN_XIOS' 71 IF (first) THEN 72 !$OMP BARRIER 73 !$OMP MASTER 74 ALLOCATE(unat(ijb_u:ije_u,llm)) 75 ALLOCATE(vnat(ijb_v:ije_v,llm)) 76 IF (pole_sud) THEN 77 ALLOCATE(vbuffer(ijb_v:ije_v+iip1,llm)) 78 ELSE 79 ALLOCATE(vbuffer(ijb_v:ije_v+iip1,llm)) 80 ENDIF 81 ALLOCATE(tm(ijb_u:ije_u,llm)) 82 ALLOCATE(ndex2d(ijnb_u*llm)) 83 ALLOCATE(ndexu(ijnb_u*llm)) 84 ALLOCATE(ndexv(ijnb_v*llm)) 85 unat = 0.; vnat = 0.; tm = 0. ; 86 ndex2d = 0 87 ndexu = 0 88 ndexv = 0 89 vbuffer=0. 90 !$OMP END MASTER 91 !$OMP BARRIER 92 first=.FALSE. 93 ENDIF 94 95 ok_sync = .TRUE. 96 itau_w = itau_dyn + time 69 ! WRITE(*,*)'IN WRITEDYN_XIOS' 70 IF (first) THEN 71 !$OMP BARRIER 72 !$OMP MASTER 73 ALLOCATE(unat(ijb_u:ije_u, llm)) 74 ALLOCATE(vnat(ijb_v:ije_v, llm)) 75 IF (pole_sud) THEN 76 ALLOCATE(vbuffer(ijb_v:ije_v + iip1, llm)) 77 ELSE 78 ALLOCATE(vbuffer(ijb_v:ije_v + iip1, llm)) 79 ENDIF 80 ALLOCATE(tm(ijb_u:ije_u, llm)) 81 ALLOCATE(ndex2d(ijnb_u * llm)) 82 ALLOCATE(ndexu(ijnb_u * llm)) 83 ALLOCATE(ndexv(ijnb_v * llm)) 84 unat = 0.; vnat = 0.; tm = 0. ; 85 ndex2d = 0 86 ndexu = 0 87 ndexv = 0 88 vbuffer = 0. 89 !$OMP END MASTER 90 !$OMP BARRIER 91 first = .FALSE. 92 ENDIF 97 93 98 ! Passage aux composantes naturelles du vent 99 CALL covnat_loc(llm, ucov, vcov, unat, vnat)94 ok_sync = .TRUE. 95 itau_w = itau_dyn + time 100 96 101 ! Appels a histwrite pour l'ecriture des variables a sauvegarder 97 ! Passage aux composantes naturelles du vent 98 CALL covnat_loc(llm, ucov, vcov, unat, vnat) 102 99 103 ! Vents U 100 ! Appels a histwrite pour l'ecriture des variables a sauvegarder 104 101 105 ijb=ij_begin 106 ije=ij_end 107 jjn=jj_nb 108 109 CALL writefield_dyn_u('U', unat(ijb:ije,:)) 102 ! Vents U 110 103 111 ! Vents V 104 ijb = ij_begin 105 ije = ij_end 106 jjn = jj_nb 112 107 113 ije=ij_end 114 IF (pole_sud) THEN 115 jjn=jj_nb-1 116 ije=ij_end-iip1 117 ENDIF 118 vbuffer(ijb:ije,:)=vnat(ijb:ije,:) 108 CALL writefield_dyn_u('U', unat(ijb:ije, :)) 119 109 110 ! Vents V 120 111 121 IF (pole_sud) THEN 122 CALL writefield_dyn_v('V', vbuffer(ijb:ije+iip1,:)) 123 ELSE 124 CALL writefield_dyn_v('V', vbuffer(ijb:ije,:)) 125 ENDIF 112 ije = ij_end 113 IF (pole_sud) THEN 114 jjn = jj_nb - 1 115 ije = ij_end - iip1 116 ENDIF 117 vbuffer(ijb:ije, :) = vnat(ijb:ije, :) 126 118 127 ! Temperature potentielle moyennee 119 IF (pole_sud) THEN 120 CALL writefield_dyn_v('V', vbuffer(ijb:ije + iip1, :)) 121 ELSE 122 CALL writefield_dyn_v('V', vbuffer(ijb:ije, :)) 123 ENDIF 128 124 129 ijb=ij_begin 130 ije=ij_end 131 jjn=jj_nb 132 CALL writefield_dyn_u('THETA', teta(ijb:ije,:)) 125 ! Temperature potentielle moyennee 133 126 134 ! Temperature moyennee 127 ijb = ij_begin 128 ije = ij_end 129 jjn = jj_nb 130 CALL writefield_dyn_u('THETA', teta(ijb:ije, :)) 135 131 136 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 137 do ll=1,llm 138 do ii = ijb, ije 139 tm(ii,ll) = teta(ii,ll) * ppk(ii,ll)/cpp 140 enddo 141 enddo 142 !$OMP ENDDO 143 CALL writefield_dyn_u('TEMP', tm(ijb:ije,:)) 132 ! Temperature moyennee 144 133 145 ! Geopotentiel 134 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 135 do ll = 1, llm 136 do ii = ijb, ije 137 tm(ii, ll) = teta(ii, ll) * ppk(ii, ll) / cpp 138 enddo 139 enddo 140 !$OMP ENDDO 141 CALL writefield_dyn_u('TEMP', tm(ijb:ije, :)) 146 142 147 CALL writefield_dyn_u('PHI', phi(ijb:ije,:))143 ! Geopotentiel 148 144 149 ! Tracers? 145 CALL writefield_dyn_u('PHI', phi(ijb:ije, :)) 150 146 151 ! DO iq=1,nqtot 152 ! ENDDO 147 ! Tracers? 153 148 154 ! Masse 149 ! DO iq=1,nqtot 150 ! ENDDO 155 151 156 CALL writefield_dyn_u('MASSE', masse(ijb:ije,:))152 ! Masse 157 153 158 ! Pression au sol 154 CALL writefield_dyn_u('MASSE', masse(ijb:ije, :)) 159 155 160 CALL writefield_dyn_u('PS', ps(ijb:ije))156 ! Pression au sol 161 157 162 END 158 CALL writefield_dyn_u('PS', ps(ijb:ije)) 159 160 END -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writedynav_loc.f90
r5113 r5114 1 2 1 ! $Id: writedynav_p.F 1279 2009-12-10 09:02:56Z fairhead $ 3 2 4 SUBROUTINE writedynav_loc( time, vcov, ucov,teta,ppk,phi,q, &5 masse, ps,phis)3 SUBROUTINE writedynav_loc(time, vcov, ucov, teta, ppk, phi, q, & 4 masse, ps, phis) 6 5 7 6 ! This routine needs IOIPSL … … 10 9 USE misc_mod 11 10 USE infotrac, ONLY: nqtot 12 use com_io_dyn_mod, ONLY: histaveid, histvaveid,histuaveid11 use com_io_dyn_mod, ONLY: histaveid, histvaveid, histuaveid 13 12 USE comconst_mod, ONLY: cpp 14 13 USE temps_mod, ONLY: itau_dyn 14 USE lmdz_description, ONLY: descript 15 15 16 16 IMPLICIT NONE … … 45 45 include "paramet.h" 46 46 include "comgeom.h" 47 include "description.h"48 47 include "iniprint.h" 49 48 … … 52 51 ! 53 52 54 REAL :: vcov(ijb_v:ije_v, llm),ucov(ijb_u:ije_u,llm)55 REAL :: teta(ijb_u:ije_u, llm),phi(ijb_u:ije_u,llm)56 REAL :: ppk(ijb_u:ije_u, llm)57 REAL :: ps(ijb_u:ije_u), masse(ijb_u:ije_u,llm)53 REAL :: vcov(ijb_v:ije_v, llm), ucov(ijb_u:ije_u, llm) 54 REAL :: teta(ijb_u:ije_u, llm), phi(ijb_u:ije_u, llm) 55 REAL :: ppk(ijb_u:ije_u, llm) 56 REAL :: ps(ijb_u:ije_u), masse(ijb_u:ije_u, llm) 58 57 REAL :: phis(ijb_u:ije_u) 59 REAL :: q(ijb_u:ije_u, llm,nqtot)58 REAL :: q(ijb_u:ije_u, llm, nqtot) 60 59 integer :: time 61 60 … … 64 63 ! Variables locales 65 64 ! 66 INTEGER, SAVE,ALLOCATABLE :: ndex2d(:),ndexu(:),ndexv(:)65 INTEGER, SAVE, ALLOCATABLE :: ndex2d(:), ndexu(:), ndexv(:) 67 66 INTEGER :: iq, ii, ll 68 REAL, SAVE,ALLOCATABLE :: tm(:,:)69 REAL, SAVE,ALLOCATABLE :: vnat(:,:),unat(:,:)67 REAL, SAVE, ALLOCATABLE :: tm(:, :) 68 REAL, SAVE, ALLOCATABLE :: vnat(:, :), unat(:, :) 70 69 logical :: ok_sync 71 70 integer :: itau_w 72 integer :: ijb, ije,jjn73 LOGICAL, SAVE :: first=.TRUE.74 !$OMP THREADPRIVATE(first)71 integer :: ijb, ije, jjn 72 LOGICAL, SAVE :: first = .TRUE. 73 !$OMP THREADPRIVATE(first) 75 74 76 75 ! … … 80 79 81 80 IF (first) THEN 82 !$OMP BARRIER83 !$OMP MASTER84 ALLOCATE(unat(ijb_u:ije_u, llm))85 ALLOCATE(vnat(ijb_v:ije_v, llm))86 ALLOCATE(tm(ijb_u:ije_u, llm))87 ALLOCATE(ndex2d(ijnb_u *llm))88 ALLOCATE(ndexu(ijnb_u *llm))89 ALLOCATE(ndexv(ijnb_v *llm))81 !$OMP BARRIER 82 !$OMP MASTER 83 ALLOCATE(unat(ijb_u:ije_u, llm)) 84 ALLOCATE(vnat(ijb_v:ije_v, llm)) 85 ALLOCATE(tm(ijb_u:ije_u, llm)) 86 ALLOCATE(ndex2d(ijnb_u * llm)) 87 ALLOCATE(ndexu(ijnb_u * llm)) 88 ALLOCATE(ndexv(ijnb_v * llm)) 90 89 ndex2d = 0 91 90 ndexu = 0 92 91 ndexv = 0 93 !$OMP END MASTER94 !$OMP BARRIER95 first =.FALSE.92 !$OMP END MASTER 93 !$OMP BARRIER 94 first = .FALSE. 96 95 ENDIF 97 96 … … 108 107 ! 109 108 110 !$OMP BARRIER111 !$OMP MASTER112 ijb =ij_begin113 ije =ij_end114 jjn =jj_nb115 116 CALL histwrite(histuaveid, 'u', itau_w, unat(ijb:ije, :), &117 iip1*jjn*llm, ndexu)118 !$OMP END MASTER109 !$OMP BARRIER 110 !$OMP MASTER 111 ijb = ij_begin 112 ije = ij_end 113 jjn = jj_nb 114 115 CALL histwrite(histuaveid, 'u', itau_w, unat(ijb:ije, :), & 116 iip1 * jjn * llm, ndexu) 117 !$OMP END MASTER 119 118 120 119 ! 121 120 ! Vents V 122 121 ! 123 ije =ij_end124 if (pole_sud) jjn =jj_nb-1125 if (pole_sud) ije =ij_end-iip1126 !$OMP BARRIER127 !$OMP MASTER128 CALL histwrite(histvaveid, 'v', itau_w, vnat(ijb:ije, :), &129 iip1*jjn*llm, ndexv)130 !$OMP END MASTER122 ije = ij_end 123 if (pole_sud) jjn = jj_nb - 1 124 if (pole_sud) ije = ij_end - iip1 125 !$OMP BARRIER 126 !$OMP MASTER 127 CALL histwrite(histvaveid, 'v', itau_w, vnat(ijb:ije, :), & 128 iip1 * jjn * llm, ndexv) 129 !$OMP END MASTER 131 130 132 131 … … 134 133 ! Temperature potentielle moyennee 135 134 ! 136 ijb =ij_begin137 ije =ij_end138 jjn =jj_nb139 !$OMP MASTER140 CALL histwrite(histaveid, 'theta', itau_w, teta(ijb:ije, :), &141 iip1*jjn*llm, ndexu)142 !$OMP END MASTER135 ijb = ij_begin 136 ije = ij_end 137 jjn = jj_nb 138 !$OMP MASTER 139 CALL histwrite(histaveid, 'theta', itau_w, teta(ijb:ije, :), & 140 iip1 * jjn * llm, ndexu) 141 !$OMP END MASTER 143 142 144 143 ! … … 146 145 ! 147 146 148 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)149 do ll =1,llm147 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 148 do ll = 1, llm 150 149 do ii = ijb, ije 151 tm(ii, ll) = teta(ii,ll) * ppk(ii,ll)/cpp150 tm(ii, ll) = teta(ii, ll) * ppk(ii, ll) / cpp 152 151 enddo 153 152 enddo 154 !$OMP ENDDO155 156 !$OMP MASTER157 CALL histwrite(histaveid, 'temp', itau_w, tm(ijb:ije, :), &158 iip1*jjn*llm, ndexu)159 !$OMP END MASTER153 !$OMP ENDDO 154 155 !$OMP MASTER 156 CALL histwrite(histaveid, 'temp', itau_w, tm(ijb:ije, :), & 157 iip1 * jjn * llm, ndexu) 158 !$OMP END MASTER 160 159 161 160 … … 163 162 ! Geopotentiel 164 163 ! 165 !$OMP MASTER166 CALL histwrite(histaveid, 'phi', itau_w, phi(ijb:ije, :), &167 iip1*jjn*llm, ndexu)168 !$OMP END MASTER164 !$OMP MASTER 165 CALL histwrite(histaveid, 'phi', itau_w, phi(ijb:ije, :), & 166 iip1 * jjn * llm, ndexu) 167 !$OMP END MASTER 169 168 170 169 … … 183 182 ! Masse 184 183 ! 185 !$OMP MASTER186 CALL histwrite(histaveid, 'masse', itau_w, masse(ijb:ije,:), &187 iip1*jjn*llm, ndexu)188 !$OMP END MASTER184 !$OMP MASTER 185 CALL histwrite(histaveid, 'masse', itau_w, masse(ijb:ije, :), & 186 iip1 * jjn * llm, ndexu) 187 !$OMP END MASTER 189 188 190 189 … … 192 191 ! Pression au sol 193 192 ! 194 !$OMP MASTER195 196 197 iip1*jjn, ndex2d)198 !$OMP END MASTER193 !$OMP MASTER 194 195 CALL histwrite(histaveid, 'ps', itau_w, ps(ijb:ije), & 196 iip1 * jjn, ndex2d) 197 !$OMP END MASTER 199 198 200 199 ! 201 200 ! Geopotentiel au sol 202 201 ! 203 !$OMP MASTER204 202 !$OMP MASTER 203 ! CALL histwrite(histaveid, 'phis', itau_w, phis(ijb:ije), 205 204 ! . iip1*jjn, ndex2d) 206 !$OMP END MASTER205 !$OMP END MASTER 207 206 208 207 ! 209 208 ! Fin 210 209 ! 211 !$OMP MASTER210 !$OMP MASTER 212 211 if (ok_sync) then 213 214 215 212 CALL histsync(histaveid) 213 CALL histsync(histvaveid) 214 CALL histsync(histuaveid) 216 215 ENDIF 217 !$OMP END MASTER216 !$OMP END MASTER 218 217 end subroutine writedynav_loc -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writehist_loc.f90
r5113 r5114 1 2 1 ! $Id: writedynav_p.F 1279 2009-12-10 09:02:56Z fairhead $ 3 2 4 SUBROUTINE writehist_loc( time, vcov, ucov,teta,ppk,phi,q, & 5 masse,ps,phis) 6 7 ! This routine needs IOIPSL 3 SUBROUTINE writehist_loc(time, vcov, ucov, teta, ppk, phi, q, masse, ps, phis) 8 4 USE ioipsl 9 5 USE parallel_lmdz 10 6 USE misc_mod 11 7 USE infotrac, ONLY: nqtot 12 use com_io_dyn_mod, ONLY: histid, histvid,histuid8 use com_io_dyn_mod, ONLY: histid, histvid, histuid 13 9 USE comconst_mod, ONLY: cpp 14 10 USE temps_mod, ONLY: itau_dyn 11 USE lmdz_description, ONLY: descript 15 12 16 13 IMPLICIT NONE … … 45 42 include "paramet.h" 46 43 include "comgeom.h" 47 include "description.h"48 44 include "iniprint.h" 49 45 … … 52 48 ! 53 49 54 REAL :: vcov(ijb_v:ije_v, llm),ucov(ijb_u:ije_u,llm)55 REAL :: teta(ijb_u:ije_u, llm),phi(ijb_u:ije_u,llm)56 REAL :: ppk(ijb_u:ije_u, llm)57 REAL :: ps(ijb_u:ije_u), masse(ijb_u:ije_u,llm)50 REAL :: vcov(ijb_v:ije_v, llm), ucov(ijb_u:ije_u, llm) 51 REAL :: teta(ijb_u:ije_u, llm), phi(ijb_u:ije_u, llm) 52 REAL :: ppk(ijb_u:ije_u, llm) 53 REAL :: ps(ijb_u:ije_u), masse(ijb_u:ije_u, llm) 58 54 REAL :: phis(ijb_u:ije_u) 59 REAL :: q(ijb_u:ije_u, llm,nqtot)55 REAL :: q(ijb_u:ije_u, llm, nqtot) 60 56 integer :: time 61 57 … … 64 60 ! Variables locales 65 61 ! 66 INTEGER, SAVE,ALLOCATABLE :: ndex2d(:),ndexu(:),ndexv(:)62 INTEGER, SAVE, ALLOCATABLE :: ndex2d(:), ndexu(:), ndexv(:) 67 63 INTEGER :: iq, ii, ll 68 REAL, SAVE,ALLOCATABLE :: tm(:,:)69 REAL, SAVE,ALLOCATABLE :: vnat(:,:),unat(:,:)64 REAL, SAVE, ALLOCATABLE :: tm(:, :) 65 REAL, SAVE, ALLOCATABLE :: vnat(:, :), unat(:, :) 70 66 logical :: ok_sync 71 67 integer :: itau_w 72 integer :: ijb, ije,jjn73 LOGICAL, SAVE :: first=.TRUE.74 !$OMP THREADPRIVATE(first)68 integer :: ijb, ije, jjn 69 LOGICAL, SAVE :: first = .TRUE. 70 !$OMP THREADPRIVATE(first) 75 71 76 72 ! … … 80 76 81 77 IF (first) THEN 82 !$OMP BARRIER83 !$OMP MASTER84 ALLOCATE(unat(ijb_u:ije_u, llm))85 ALLOCATE(vnat(ijb_v:ije_v, llm))86 ALLOCATE(tm(ijb_u:ije_u, llm))87 ALLOCATE(ndex2d(ijnb_u *llm))88 ALLOCATE(ndexu(ijnb_u *llm))89 ALLOCATE(ndexv(ijnb_v *llm))78 !$OMP BARRIER 79 !$OMP MASTER 80 ALLOCATE(unat(ijb_u:ije_u, llm)) 81 ALLOCATE(vnat(ijb_v:ije_v, llm)) 82 ALLOCATE(tm(ijb_u:ije_u, llm)) 83 ALLOCATE(ndex2d(ijnb_u * llm)) 84 ALLOCATE(ndexu(ijnb_u * llm)) 85 ALLOCATE(ndexv(ijnb_v * llm)) 90 86 ndex2d = 0 91 87 ndexu = 0 92 88 ndexv = 0 93 !$OMP END MASTER94 !$OMP BARRIER95 first =.FALSE.89 !$OMP END MASTER 90 !$OMP BARRIER 91 first = .FALSE. 96 92 ENDIF 97 93 … … 108 104 ! 109 105 110 !$OMP BARRIER111 !$OMP MASTER112 ijb =ij_begin113 ije =ij_end114 jjn =jj_nb115 116 CALL histwrite(histuid, 'u', itau_w, unat(ijb:ije, :), &117 iip1*jjn*llm, ndexu)118 !$OMP END MASTER106 !$OMP BARRIER 107 !$OMP MASTER 108 ijb = ij_begin 109 ije = ij_end 110 jjn = jj_nb 111 112 CALL histwrite(histuid, 'u', itau_w, unat(ijb:ije, :), & 113 iip1 * jjn * llm, ndexu) 114 !$OMP END MASTER 119 115 120 116 ! 121 117 ! Vents V 122 118 ! 123 ije =ij_end124 if (pole_sud) jjn =jj_nb-1125 if (pole_sud) ije =ij_end-iip1126 !$OMP BARRIER127 !$OMP MASTER128 CALL histwrite(histvid, 'v', itau_w, vnat(ijb:ije, :), &129 iip1*jjn*llm, ndexv)130 !$OMP END MASTER119 ije = ij_end 120 if (pole_sud) jjn = jj_nb - 1 121 if (pole_sud) ije = ij_end - iip1 122 !$OMP BARRIER 123 !$OMP MASTER 124 CALL histwrite(histvid, 'v', itau_w, vnat(ijb:ije, :), & 125 iip1 * jjn * llm, ndexv) 126 !$OMP END MASTER 131 127 132 128 … … 134 130 ! Temperature potentielle 135 131 ! 136 ijb =ij_begin137 ije =ij_end138 jjn =jj_nb139 !$OMP MASTER140 CALL histwrite(histid, 'theta', itau_w, teta(ijb:ije, :), &141 iip1*jjn*llm, ndexu)142 !$OMP END MASTER132 ijb = ij_begin 133 ije = ij_end 134 jjn = jj_nb 135 !$OMP MASTER 136 CALL histwrite(histid, 'theta', itau_w, teta(ijb:ije, :), & 137 iip1 * jjn * llm, ndexu) 138 !$OMP END MASTER 143 139 144 140 ! … … 146 142 ! 147 143 148 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)149 do ll =1,llm144 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 145 do ll = 1, llm 150 146 do ii = ijb, ije 151 tm(ii, ll) = teta(ii,ll) * ppk(ii,ll)/cpp147 tm(ii, ll) = teta(ii, ll) * ppk(ii, ll) / cpp 152 148 enddo 153 149 enddo 154 !$OMP ENDDO155 156 !$OMP MASTER157 CALL histwrite(histid, 'temp', itau_w, tm(ijb:ije, :), &158 iip1*jjn*llm, ndexu)159 !$OMP END MASTER150 !$OMP ENDDO 151 152 !$OMP MASTER 153 CALL histwrite(histid, 'temp', itau_w, tm(ijb:ije, :), & 154 iip1 * jjn * llm, ndexu) 155 !$OMP END MASTER 160 156 161 157 … … 163 159 ! Geopotentiel 164 160 ! 165 !$OMP MASTER166 CALL histwrite(histid, 'phi', itau_w, phi(ijb:ije, :), &167 iip1*jjn*llm, ndexu)168 !$OMP END MASTER161 !$OMP MASTER 162 CALL histwrite(histid, 'phi', itau_w, phi(ijb:ije, :), & 163 iip1 * jjn * llm, ndexu) 164 !$OMP END MASTER 169 165 170 166 … … 183 179 ! Masse 184 180 ! 185 !$OMP MASTER186 CALL histwrite(histid, 'masse', itau_w, masse(ijb:ije,:), &187 iip1*jjn*llm, ndexu)188 !$OMP END MASTER181 !$OMP MASTER 182 CALL histwrite(histid, 'masse', itau_w, masse(ijb:ije, :), & 183 iip1 * jjn * llm, ndexu) 184 !$OMP END MASTER 189 185 190 186 … … 192 188 ! Pression au sol 193 189 ! 194 !$OMP MASTER195 196 iip1*jjn, ndex2d)197 !$OMP END MASTER190 !$OMP MASTER 191 CALL histwrite(histid, 'ps', itau_w, ps(ijb:ije), & 192 iip1 * jjn, ndex2d) 193 !$OMP END MASTER 198 194 199 195 ! 200 196 ! Geopotentiel au sol 201 197 ! 202 !$OMP MASTER203 198 !$OMP MASTER 199 ! CALL histwrite(histid, 'phis', itau_w, phis(ijb:ije), 204 200 ! . iip1*jjn, ndex2d) 205 !$OMP END MASTER201 !$OMP END MASTER 206 202 207 203 ! 208 204 ! Fin 209 205 ! 210 !$OMP MASTER206 !$OMP MASTER 211 207 if (ok_sync) then 212 208 CALL histsync(histid) … … 214 210 CALL histsync(histuid) 215 211 endif 216 !$OMP END MASTER212 !$OMP END MASTER 217 213 end subroutine writehist_loc -
LMDZ6/branches/Amaury_dev/libf/misc/lmdz_coefpoly.f90
r5113 r5114 1 module coefpoly_m1 module lmdz_coefpoly 2 2 3 3 IMPLICIT NONE … … 27 27 use nrtype, only: k8 28 28 29 REAL(K8), intent(in) :: xf1, xf2, xprim1, xprim2, xtild1, xtild230 REAL(K8), intent(out) :: a0, a1, a2, a329 REAL(K8), intent(in) :: xf1, xf2, xprim1, xprim2, xtild1, xtild2 30 REAL(K8), intent(out) :: a0, a1, a2, a3 31 31 32 32 ! Local: … … 38 38 xtil2car = xtild2 * xtild2 39 39 40 derr = 2. * (xf2 -xf1)/(xtild1-xtild2)40 derr = 2. * (xf2 - xf1) / (xtild1 - xtild2) 41 41 42 x1x2car = (xtild1 -xtild2) * (xtild1-xtild2)42 x1x2car = (xtild1 - xtild2) * (xtild1 - xtild2) 43 43 44 a3 = (derr +xprim1+xprim2)/x1x2car45 a2 = (xprim1 -xprim2+3. * a3 * (xtil2car-xtil1car))/(2. * (xtild1-xtild2))44 a3 = (derr + xprim1 + xprim2) / x1x2car 45 a2 = (xprim1 - xprim2 + 3. * a3 * (xtil2car - xtil1car)) / (2. * (xtild1 - xtild2)) 46 46 47 47 a1 = xprim1 - 3. * a3 * xtil1car - 2. * a2 * xtild1 … … 50 50 END SUBROUTINE coefpoly 51 51 52 end module coefpoly_m52 end module lmdz_coefpoly -
LMDZ6/branches/Amaury_dev/libf/misc/lmdz_description.f90
r5105 r5114 1 ! Replaces description.h 1 2 2 ! $Header$ 3 4 character (len=120) :: descript 5 common /titre/descript 3 MODULE lmdz_description 4 IMPLICIT NONE; PRIVATE 5 PUBLIC descript 6 CHARACTER (LEN = 120) :: descript 7 END MODULE lmdz_description
Note: See TracChangeset
for help on using the changeset viewer.