| 1 | SUBROUTINE phygrid_ncfile_npp (filename) |
|---|
| 2 | !-------------------------------------------------------------- |
|---|
| 3 | ! Prepare a netCDF file for lmdz physics grid |
|---|
| 4 | ! |
|---|
| 5 | ! Field units: in this file used by the GCM all units are |
|---|
| 6 | ! in kg-species/m2/s. The fields are modified accordingly. |
|---|
| 7 | !-------------------------------------------------------------- |
|---|
| 8 | USE sflx |
|---|
| 9 | USE final_grid_lmdz |
|---|
| 10 | USE grid, ONLY: nrecs |
|---|
| 11 | |
|---|
| 12 | IMPLICIT NONE |
|---|
| 13 | |
|---|
| 14 | INCLUDE 'netcdf.inc' |
|---|
| 15 | |
|---|
| 16 | !-------------------------------------------------------------- |
|---|
| 17 | ! ... Dummy arguments |
|---|
| 18 | !-------------------------------------------------------------- |
|---|
| 19 | CHARACTER(LEN=*), INTENT(in) :: filename |
|---|
| 20 | |
|---|
| 21 | !-------------------------------------------------------------- |
|---|
| 22 | ! ... Local variables |
|---|
| 23 | !-------------------------------------------------------------- |
|---|
| 24 | CHARACTER(LEN=100) :: name |
|---|
| 25 | INTEGER :: len_name |
|---|
| 26 | INTEGER :: iret |
|---|
| 27 | INTEGER :: ncid |
|---|
| 28 | INTEGER :: i |
|---|
| 29 | |
|---|
| 30 | ! ... Dimension ids |
|---|
| 31 | INTEGER :: vector_dim |
|---|
| 32 | INTEGER :: time_dim |
|---|
| 33 | |
|---|
| 34 | ! ... Dimension lengths |
|---|
| 35 | INTEGER, PARAMETER :: time_len = NF_UNLIMITED |
|---|
| 36 | INTEGER, PARAMETER :: month_len = 12 |
|---|
| 37 | |
|---|
| 38 | ! ... Variable ids |
|---|
| 39 | INTEGER :: vector_id |
|---|
| 40 | INTEGER :: time_id |
|---|
| 41 | INTEGER :: npp_id |
|---|
| 42 | |
|---|
| 43 | INTEGER, PARAMETER :: vector_rank = 1 |
|---|
| 44 | INTEGER, PARAMETER :: time_rank = 1 |
|---|
| 45 | |
|---|
| 46 | INTEGER :: vector_dims(vector_rank) |
|---|
| 47 | INTEGER :: time_dims(time_rank) |
|---|
| 48 | INTEGER :: time_start(time_rank), time_count(time_rank) |
|---|
| 49 | |
|---|
| 50 | REAL :: month(month_len) |
|---|
| 51 | REAL :: vector (klon) |
|---|
| 52 | REAL :: field (klon, month_len) |
|---|
| 53 | |
|---|
| 54 | INTEGER, PARAMETER :: npp_rank = 2 |
|---|
| 55 | INTEGER :: npp_dims(npp_rank) |
|---|
| 56 | |
|---|
| 57 | DATA month /15.,45.,75.,105.,135.,165.,195.,225.,255.,285.,315.,345./ |
|---|
| 58 | |
|---|
| 59 | DO i = 1, klon |
|---|
| 60 | vector(i) = FLOAT(i) |
|---|
| 61 | END DO |
|---|
| 62 | |
|---|
| 63 | ! ... Enter define mode |
|---|
| 64 | PRINT *, ' Enter netcdf define mode ...' |
|---|
| 65 | iret = nf_create(filename, NF_CLOBBER, ncid) |
|---|
| 66 | CALL check_err(iret) |
|---|
| 67 | |
|---|
| 68 | ! ... Define dimensions |
|---|
| 69 | iret = nf_def_dim(ncid, 'vector', klon, vector_dim) |
|---|
| 70 | CALL check_err(iret) |
|---|
| 71 | iret = nf_def_dim(ncid, 'time', NF_UNLIMITED, time_dim) |
|---|
| 72 | CALL check_err(iret) |
|---|
| 73 | |
|---|
| 74 | vector_dims(1) = vector_dim |
|---|
| 75 | iret = nf_def_var(ncid, 'vector', NF_FLOAT, vector_rank, vector_dims, vector_id) |
|---|
| 76 | CALL check_err(iret) |
|---|
| 77 | time_dims(1) = time_dim |
|---|
| 78 | iret = nf_def_var(ncid, 'time', NF_FLOAT, time_rank, time_dims, time_id) |
|---|
| 79 | CALL check_err(iret) |
|---|
| 80 | |
|---|
| 81 | name = 'LMDz surface emissions' |
|---|
| 82 | len_name = LEN_TRIM(ADJUSTL(name)) |
|---|
| 83 | iret = nf_put_att_text(ncid, NF_GLOBAL, 'title', len_name, name(:LEN_TRIM(name))) |
|---|
| 84 | CALL check_err(iret) |
|---|
| 85 | name = 'S. Szopa' |
|---|
| 86 | len_name = LEN_TRIM(ADJUSTL(name)) |
|---|
| 87 | iret = nf_put_att_text(ncid, NF_GLOBAL, 'source', len_name, name(:LEN_TRIM(name))) |
|---|
| 88 | CALL check_err(iret) |
|---|
| 89 | name = 'physics grid point' |
|---|
| 90 | len_name = LEN_TRIM(ADJUSTL(name)) |
|---|
| 91 | iret = nf_put_att_text(ncid, vector_id, 'long_name', len_name, name(:LEN_TRIM(name))) |
|---|
| 92 | CALL check_err(iret) |
|---|
| 93 | name = 'index' |
|---|
| 94 | len_name = LEN_TRIM(ADJUSTL(name)) |
|---|
| 95 | iret = nf_put_att_text(ncid, vector_id, 'units', len_name, name(:LEN_TRIM(name))) |
|---|
| 96 | CALL check_err(iret) |
|---|
| 97 | name = 'days since 0000-01-01' |
|---|
| 98 | len_name = LEN_TRIM(ADJUSTL(name)) |
|---|
| 99 | iret = nf_put_att_text(ncid, time_id, 'units', len_name, name(:LEN_TRIM(name))) |
|---|
| 100 | CALL check_err(iret) |
|---|
| 101 | name = 'Time' |
|---|
| 102 | len_name = LEN_TRIM(ADJUSTL(name)) |
|---|
| 103 | iret = nf_put_att_text(ncid, time_id, 'long_name', len_name, name(:LEN_TRIM(name))) |
|---|
| 104 | CALL check_err(iret) |
|---|
| 105 | |
|---|
| 106 | ! ... Fields |
|---|
| 107 | npp_dims(2) = time_dim |
|---|
| 108 | npp_dims(1) = vector_dim |
|---|
| 109 | |
|---|
| 110 | iret = nf_def_var(ncid, 'NPP', NF_FLOAT, npp_rank, npp_dims, npp_id) |
|---|
| 111 | CALL check_err(iret) |
|---|
| 112 | name = 'vmr' |
|---|
| 113 | len_name = LEN_TRIM(ADJUSTL(name)) |
|---|
| 114 | iret = nf_put_att_text(ncid, npp_id, 'units', len_name, name(:LEN_TRIM(name))) |
|---|
| 115 | CALL check_err(iret) |
|---|
| 116 | name = 'NPP' |
|---|
| 117 | len_name = LEN_TRIM(ADJUSTL(name)) |
|---|
| 118 | iret = nf_put_att_text(ncid, npp_id, 'long_name', len_name, name(:LEN_TRIM(name))) |
|---|
| 119 | CALL check_err(iret) |
|---|
| 120 | |
|---|
| 121 | |
|---|
| 122 | ! ... Leave define mode |
|---|
| 123 | PRINT *, ' Leave netcdf define mode.' |
|---|
| 124 | iret = nf_enddef(ncid) |
|---|
| 125 | CALL check_err(iret) |
|---|
| 126 | |
|---|
| 127 | PRINT *, ' Store variables ...' |
|---|
| 128 | ! ... Store time |
|---|
| 129 | time_start(1) = 1 |
|---|
| 130 | time_count(1) = month_len |
|---|
| 131 | iret = nf_put_vara_real(ncid, time_id, time_start, time_count, month) |
|---|
| 132 | CALL check_err(iret) |
|---|
| 133 | |
|---|
| 134 | ! ... store vector |
|---|
| 135 | iret = nf_put_var_real(ncid, vector_id, vector) |
|---|
| 136 | CALL check_err(iret) |
|---|
| 137 | |
|---|
| 138 | ! ... store fields |
|---|
| 139 | iret = nf_put_var_real(ncid, npp_id, npp_phy) |
|---|
| 140 | CALL check_err(iret) |
|---|
| 141 | |
|---|
| 142 | |
|---|
| 143 | PRINT *, ' Done phy file.' |
|---|
| 144 | iret = nf_close(ncid) |
|---|
| 145 | CALL check_err(iret) |
|---|
| 146 | |
|---|
| 147 | END SUBROUTINE phygrid_ncfile_npp |
|---|
