source: codes/icosagcm/trunk/src/disvert.f90 @ 131

Last change on this file since 131 was 131, checked in by ymipsl, 11 years ago

Some operations must be only done by the mpi master task.

YM
File size: 4.5 KB
Line 
1MODULE disvert_mod
2  USE icosa
3  REAL(rstd), SAVE, POINTER :: ap(:)
4  REAL(rstd), SAVE, POINTER :: bp(:)
5  REAL(rstd), SAVE, POINTER :: presnivs(:)
6
7CONTAINS
8
9  SUBROUTINE init_disvert
10  USE disvert_std_mod, ONLY: ap_std=>ap, bp_std=>bp, presnivs_std=>presnivs, init_disvert_std=>init_disvert
11  USE disvert_ncar_mod, ONLY: ap_ncar=>ap, bp_ncar=>bp, presnivs_ncar=>presnivs, init_disvert_ncar=>init_disvert
12  USE disvert_ncarl30_mod, ONLY: ap_ncarl30=>ap, bp_ncarl30=>bp, presnivs_ncarl30=>presnivs, init_disvert_ncarl30=>init_disvert
13  USE disvert_dcmip31_mod, ONLY: ap_dcmip31=>ap, bp_dcmip31=>bp, presnivs_dcmip31=>presnivs, init_disvert_dcmip31=>init_disvert
14  USE disvert_dcmip200_mod, ONLY: ap_dcmip200=>ap, bp_dcmip200=>bp, presnivs_dcmip200=>presnivs, init_disvert_dcmip200=>init_disvert
15  USE icosa
16  USE mpipara
17  IMPLICIT NONE
18    CHARACTER(LEN=255) :: disvert_type = 'std'
19   
20    CALL getin("disvert",disvert_type)
21   
22    SELECT CASE (TRIM(disvert_type))
23      CASE('std')
24   
25        CALL init_disvert_std
26        ap=>ap_std
27        bp=>bp_std
28        presnivs=>presnivs_std
29     
30      CASE ('ncar')
31
32        CALL init_disvert_ncar
33        ap=>ap_ncar
34        bp=>bp_ncar
35        presnivs=>presnivs_ncar
36
37      CASE ('dcmip31')
38
39        CALL init_disvert_dcmip31
40        ap=>ap_dcmip31
41        bp=>bp_dcmip31
42        presnivs=>presnivs_dcmip31
43
44      CASE ('dcmip200')
45
46        CALL init_disvert_dcmip200
47        ap=>ap_dcmip200
48        bp=>bp_dcmip200
49        presnivs=>presnivs_dcmip200
50
51      CASE ('ncarl30')
52
53        CALL init_disvert_ncarl30
54        ap=>ap_ncarl30
55        bp=>bp_ncarl30
56        presnivs=>presnivs_ncarl30
57       
58      CASE default
59        IF (is_mpi_root) PRINT*,'Bad selector for variable disvert : <', TRIM(disvert_type),"> options are <std>, <ncar>, <ncarl30>" 
60        STOP
61       
62    END SELECT
63
64  END SUBROUTINE init_disvert 
65 
66  SUBROUTINE write_apbp
67  USE icosa
68  USE netcdf_mod
69  IMPLICIT NONE
70    REAL(rstd) :: val(llm)
71    INTEGER :: status
72    INTEGER :: lev,ilev
73    INTEGER :: ncid,levid,ilevid,hyaiid,hybiid,hyamid,hybmid,P0id
74    INTEGER :: l
75   
76    status = NF90_CREATE('apbp.nc', NF90_CLOBBER, ncid)
77    status = NF90_DEF_DIM(ncid,'lev',llm,lev)
78    status = NF90_DEF_DIM(ncid,'ilev',llm+1,ilev)
79   
80    status = NF90_DEF_VAR(ncid,'lev',NF90_DOUBLE,(/ lev /),levid)
81    status = NF90_PUT_ATT(ncid,levid,"long_name","hybrid level at midpoints (1000*(A+B))")
82    status = NF90_PUT_ATT(ncid,levid,"units","Pa")
83    status = NF90_PUT_ATT(ncid,levid,"positive","up")
84    status = NF90_PUT_ATT(ncid,levid,"standard_name","atmosphere_hybrid_sigma_pressure_coordinate")
85    status = NF90_PUT_ATT(ncid,levid,"formula_terms","a: hyam b: hybm p0: P0 ps: PS")
86
87    status = NF90_DEF_VAR(ncid,'ilev',NF90_DOUBLE,(/ ilev /),ilevid)
88    status = NF90_PUT_ATT(ncid,ilevid,"long_name","hybrid level at interfaces (1000*(A+B))")
89    status = NF90_PUT_ATT(ncid,ilevid,"units","Pa")
90    status = NF90_PUT_ATT(ncid,ilevid,"positive","up")
91    status = NF90_PUT_ATT(ncid,ilevid,"standard_name","atmosphere_hybrid_sigma_pressure_coordinate")
92    status = NF90_PUT_ATT(ncid,ilevid,"formula_terms","a: hyai b: hybi p0: P0 ps: PS")
93   
94    status = NF90_DEF_VAR(ncid,'hyai',NF90_DOUBLE,(/ ilev /),hyaiid)
95    status = NF90_PUT_ATT(ncid,hyaiid,"long_name","hybrid A coefficient at layer interfaces")
96
97    status = NF90_DEF_VAR(ncid,'hybi',NF90_DOUBLE,(/ ilev /),hybiid)
98    status = NF90_PUT_ATT(ncid,hybiid,"long_name","hybrid B coefficient at layer interfaces")
99
100    status = NF90_DEF_VAR(ncid,'hyam',NF90_DOUBLE,(/ lev /),hyamid)
101    status = NF90_PUT_ATT(ncid,hyamid,"long_name","hybrid A coefficient at midpoint interfaces")
102
103    status = NF90_DEF_VAR(ncid,'hybm',NF90_DOUBLE,(/ lev /),hybmid)
104    status = NF90_PUT_ATT(ncid,hybmid,"long_name","hybrid B coefficient at midpoint interfaces")
105   
106    status = NF90_DEF_VAR(ncid,'P0',NF90_DOUBLE,varid=P0id)
107
108    status = NF90_ENDDEF(ncid)   
109   
110    status=NF90_PUT_VAR(ncid,ilevid, ap(:)+bp(:)*Preff)
111   
112    DO l=1,llm
113      val(l)= 0.5*(ap(l+1)+ap(l)+Preff*(bp(l)+bp(l+1)))
114    ENDDO
115   
116    status=NF90_PUT_VAR(ncid,levid, val)
117
118    status=NF90_PUT_VAR(ncid,hyaiid, ap(:)/Preff)
119    status=NF90_PUT_VAR(ncid,hybiid, bp(:))
120   
121    DO l=1,llm
122      val(l)= 0.5*(ap(l+1)+ap(l))
123    ENDDO
124    status=NF90_PUT_VAR(ncid,hyamid, val(:)/Preff)
125   
126     DO l=1,llm
127      val(l)= 0.5*(bp(l+1)+bp(l))
128    ENDDO
129    status=NF90_PUT_VAR(ncid,hybmid, val(:))
130 
131    status=NF90_PUT_VAR(ncid,P0id, Preff)
132   
133   status=NF90_CLOSE(ncid)
134  END SUBROUTINE write_apbp
135
136END MODULE disvert_mod
Note: See TracBrowser for help on using the repository browser.