[1992] | 1 | SUBROUTINE inistats(ierr) |
---|
[1486] | 2 | |
---|
[1992] | 3 | IMPLICIT NONE |
---|
[1486] | 4 | |
---|
[1992] | 5 | include "dimensions.h" |
---|
| 6 | include "paramet.h" |
---|
| 7 | include "comgeom.h" |
---|
| 8 | include "comvert.h" |
---|
| 9 | include "comconst.h" |
---|
| 10 | include "statto.h" |
---|
| 11 | include "netcdf.inc" |
---|
[1486] | 12 | |
---|
[1992] | 13 | INTEGER, INTENT (OUT) :: ierr |
---|
| 14 | INTEGER :: nid |
---|
| 15 | INTEGER :: l, nsteppd |
---|
| 16 | REAL, DIMENSION (llm) :: sig_s |
---|
| 17 | INTEGER :: idim_lat, idim_lon, idim_llm, idim_llmp1, idim_time |
---|
| 18 | REAL, DIMENSION (istime) :: lt |
---|
| 19 | INTEGER :: nvarid |
---|
[1486] | 20 | |
---|
[1992] | 21 | WRITE (*, *) |
---|
| 22 | WRITE (*, *) ' || STATS ||' |
---|
| 23 | WRITE (*, *) |
---|
| 24 | WRITE (*, *) 'daysec', daysec |
---|
| 25 | WRITE (*, *) 'dtphys', dtphys |
---|
| 26 | nsteppd = nint(daysec/dtphys) |
---|
| 27 | WRITE (*, *) 'nsteppd=', nsteppd |
---|
| 28 | IF (abs(float(nsteppd)-daysec/dtphys)>1.E-8*daysec) & |
---|
| 29 | STOP 'Dans Instat: 1jour .ne. n pas physiques' |
---|
[1486] | 30 | |
---|
[1992] | 31 | IF (mod(nsteppd,istime)/=0) STOP & |
---|
| 32 | 'Dans Instat: 1jour .ne. n*istime pas physiques' |
---|
[1486] | 33 | |
---|
[1992] | 34 | istats = nsteppd/istime |
---|
| 35 | WRITE (*, *) 'istats=', istats |
---|
| 36 | WRITE (*, *) 'Storing ', istime, 'times per day' |
---|
| 37 | WRITE (*, *) 'thus every ', istats, 'physical timestep ' |
---|
| 38 | WRITE (*, *) |
---|
[1486] | 39 | |
---|
[1992] | 40 | DO l = 1, llm |
---|
| 41 | sig_s(l) = ((ap(l)+ap(l+1))/preff+bp(l)+bp(l+1))/2. |
---|
| 42 | pseudoalt(l) = log(preff/presnivs(l))*8. |
---|
| 43 | END DO |
---|
[1486] | 44 | |
---|
[1992] | 45 | ierr = nf_create('stats.nc', nf_clobber, nid) |
---|
| 46 | IF (ierr/=nf_noerr) THEN |
---|
| 47 | WRITE (*, *) nf_strerror(ierr) |
---|
| 48 | STOP '' |
---|
| 49 | END IF |
---|
[1486] | 50 | |
---|
[1992] | 51 | ierr = nf_def_dim(nid, 'latitude', jjp1, idim_lat) |
---|
| 52 | ierr = nf_def_dim(nid, 'longitude', iip1, idim_lon) |
---|
| 53 | ierr = nf_def_dim(nid, 'altitude', llm, idim_llm) |
---|
| 54 | ierr = nf_def_dim(nid, 'llmp1', llm+1, idim_llmp1) |
---|
| 55 | ierr = nf_def_dim(nid, 'Time', nf_unlimited, idim_time) |
---|
[1486] | 56 | |
---|
[1992] | 57 | ierr = nf_enddef(nid) |
---|
| 58 | CALL def_var_stats(nid, 'Time', 'Time', 'hours since 0000-00-0 00:00:00', & |
---|
| 59 | 1, idim_time, nvarid, ierr) |
---|
| 60 | ! Time is initialised later by mkstats subroutine |
---|
[1486] | 61 | |
---|
[1992] | 62 | CALL def_var_stats(nid, 'latitude', 'latitude', 'degrees_north', 1, & |
---|
| 63 | idim_lat, nvarid, ierr) |
---|
[1486] | 64 | #ifdef NC_DOUBLE |
---|
[1992] | 65 | ierr = nf_put_var_double(nid, nvarid, rlatu/pi*180) |
---|
[1486] | 66 | #else |
---|
[1992] | 67 | ierr = nf_put_var_real(nid, nvarid, rlatu/pi*180) |
---|
[1486] | 68 | #endif |
---|
[1992] | 69 | CALL def_var_stats(nid, 'longitude', 'East longitude', 'degrees_east', 1, & |
---|
| 70 | idim_lon, nvarid, ierr) |
---|
[1486] | 71 | #ifdef NC_DOUBLE |
---|
[1992] | 72 | ierr = nf_put_var_double(nid, nvarid, rlonv/pi*180) |
---|
[1486] | 73 | #else |
---|
[1992] | 74 | ierr = nf_put_var_real(nid, nvarid, rlonv/pi*180) |
---|
[1486] | 75 | #endif |
---|
| 76 | |
---|
[1992] | 77 | ! Niveaux verticaux, aps et bps |
---|
| 78 | ierr = nf_redef(nid) |
---|
| 79 | ! presnivs |
---|
[1486] | 80 | #ifdef NC_DOUBLE |
---|
[1992] | 81 | ierr = nf_def_var(nid, 'presnivs', nf_double, 1, idim_llm, nvarid) |
---|
[1486] | 82 | #else |
---|
[1992] | 83 | ierr = nf_def_var(nid, 'presnivs', nf_float, 1, idim_llm, nvarid) |
---|
[1486] | 84 | #endif |
---|
[1992] | 85 | ierr = nf_put_att_text(nid, nvarid, 'long_name', 15, 'Vertical levels') |
---|
| 86 | ierr = nf_put_att_text(nid, nvarid, 'units', 2, 'Pa') |
---|
| 87 | ierr = nf_put_att_text(nid, nvarid, 'positive', 4, 'down') |
---|
| 88 | ierr = nf_enddef(nid) |
---|
[1486] | 89 | #ifdef NC_DOUBLE |
---|
[1992] | 90 | ierr = nf_put_var_double(nid, nvarid, presnivs(1:llm)) |
---|
[1486] | 91 | #else |
---|
[1992] | 92 | ierr = nf_put_var_real(nid, nvarid, presnivs(1:llm)) |
---|
| 93 | #endif |
---|
| 94 | ! Pseudo alts |
---|
[1486] | 95 | #ifdef NC_DOUBLE |
---|
[1992] | 96 | ierr = nf_def_var(nid, 'altitude', nf_double, 1, idim_llm, nvarid) |
---|
[1486] | 97 | #else |
---|
[1992] | 98 | ierr = nf_def_var(nid, 'altitude', nf_float, 1, idim_llm, nvarid) |
---|
[1486] | 99 | #endif |
---|
[1992] | 100 | ierr = nf_put_att_text(nid, nvarid, 'long_name', 8, 'altitude') |
---|
| 101 | ierr = nf_put_att_text(nid, nvarid, 'units', 2, 'km') |
---|
| 102 | ierr = nf_put_att_text(nid, nvarid, 'positive', 2, 'up') |
---|
| 103 | ierr = nf_enddef(nid) |
---|
[1486] | 104 | #ifdef NC_DOUBLE |
---|
[1992] | 105 | ierr = nf_put_var_double(nid, nvarid, pseudoalt) |
---|
[1486] | 106 | #else |
---|
[1992] | 107 | ierr = nf_put_var_real(nid, nvarid, pseudoalt) |
---|
| 108 | #endif |
---|
| 109 | ! call def_var_stats(nid,"aps","hybrid pressure at midlayers"," ", |
---|
| 110 | ! & 1,idim_llm,nvarid,ierr) |
---|
| 111 | ! #ifdef NC_DOUBLE |
---|
| 112 | ! ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aps) |
---|
| 113 | ! #else |
---|
| 114 | ! ierr = NF_PUT_VAR_REAL (nid,nvarid,aps) |
---|
| 115 | ! #endif |
---|
[1486] | 116 | |
---|
[1992] | 117 | ! call def_var_stats(nid,"bps","hybrid sigma at midlayers"," ", |
---|
| 118 | ! & 1,idim_llm,nvarid,ierr) |
---|
| 119 | ! #ifdef NC_DOUBLE |
---|
| 120 | ! ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bps) |
---|
| 121 | ! #else |
---|
| 122 | ! ierr = NF_PUT_VAR_REAL (nid,nvarid,bps) |
---|
| 123 | ! #endif |
---|
[1486] | 124 | |
---|
[1992] | 125 | ierr = nf_close(nid) |
---|
[1486] | 126 | |
---|
[1992] | 127 | END SUBROUTINE inistats |
---|
[1486] | 128 | |
---|