Changeset 12080 for utils/tools/SIREN/src/grid_hgr.f90
- Timestamp:
- 2019-12-06T10:30:14+01:00 (4 years ago)
- File:
-
- 1 edited
-
utils/tools/SIREN/src/grid_hgr.f90 (modified) (30 diffs)
Legend:
- Unmodified
- Added
- Removed
-
utils/tools/SIREN/src/grid_hgr.f90
r9598 r12080 2 2 ! NEMO system team, System and Interface for oceanic RElocable Nesting 3 3 !---------------------------------------------------------------------- 4 !5 ! MODULE: grid_hgr6 4 ! 7 5 ! DESCRIPTION: … … 60 58 !> @author 61 59 !> G, Madec 62 ! REVISION HISTORY:60 !> 63 61 !> @date March, 1988 - Original code 64 62 !> @date January, 1996 … … 88 86 !> - J, Paul : do not use anymore special case for ORCA grid 89 87 !> 90 !> @note Software governed by the CeCILL licence ( ./LICENSE)88 !> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 91 89 !---------------------------------------------------------------------- 92 90 MODULE grid_hgr 91 93 92 USE netcdf ! nf90 library 94 93 USE kind ! F90 kind parameter … … 106 105 USE iom_mpp ! I/O MPP manager 107 106 USE lbc ! lateral boundary conditions 107 108 108 IMPLICIT NONE 109 109 ! NOTE_avoid_public_variables_if_possible … … 242 242 243 243 CONTAINS 244 !------------------------------------------------------------------- 245 !> @brief This function initialise hgr structure 244 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 245 SUBROUTINE grid_hgr_init(jpi, jpj, jpk, ld_domcfg) 246 !------------------------------------------------------------------- 247 !> @brief This subroutine initialise hgr structure 246 248 !> 247 249 !> @author J.Paul … … 251 253 !> @param[in] jpj 252 254 !------------------------------------------------------------------- 253 SUBROUTINE grid_hgr_init(jpi,jpj,jpk,ld_domcfg) 255 254 256 IMPLICIT NONE 257 255 258 ! Argument 256 259 INTEGER(i4), INTENT(IN) :: jpi … … 323 326 324 327 END SUBROUTINE grid_hgr_init 325 !------------------------------------------------------------------- 326 !> @brief This function clean hgr structure 328 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 329 SUBROUTINE grid_hgr_clean(ld_domcfg) 330 !------------------------------------------------------------------- 331 !> @brief This subroutine clean hgr structure 327 332 !> 328 333 !> @author J.Paul … … 330 335 !> 331 336 !------------------------------------------------------------------- 332 SUBROUTINE grid_hgr_clean(ld_domcfg) 337 333 338 IMPLICIT NONE 339 334 340 ! Argument 335 341 LOGICAL , INTENT(IN) :: ld_domcfg … … 382 388 ENDIF 383 389 END SUBROUTINE grid_hgr_clean 390 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 391 FUNCTION grid_hgr_nam(cd_coord, id_perio, cd_namelist) & 392 & RESULT (tf_namh) 384 393 !------------------------------------------------------------------- 385 394 !> @brief This function initialise hgr namelist structure … … 393 402 !> @return hgr namelist structure 394 403 !------------------------------------------------------------------- 395 FUNCTION grid_hgr_nam( cd_coord,id_perio,cd_namelist ) 404 396 405 IMPLICIT NONE 406 397 407 ! Argument 398 408 CHARACTER(LEN=*), INTENT(IN) :: cd_coord … … 401 411 402 412 ! function 403 TYPE(TNAMH) :: grid_hgr_nam413 TYPE(TNAMH) :: tf_namh 404 414 405 415 ! local variable … … 461 471 462 472 OPEN( il_fileid, FILE=TRIM(cd_namelist), & 463 &FORM='FORMATTED', &464 &ACCESS='SEQUENTIAL', &465 &STATUS='OLD', &466 &ACTION='READ', &467 &IOSTAT=il_status)473 & FORM='FORMATTED', & 474 & ACCESS='SEQUENTIAL', & 475 & STATUS='OLD', & 476 & ACTION='READ', & 477 & IOSTAT=il_status) 468 478 CALL fct_err(il_status) 469 479 IF( il_status /= 0 )THEN … … 482 492 ENDIF 483 493 484 grid_hgr_nam%c_coord = TRIM(cd_coord)485 grid_hgr_nam%i_perio = id_perio486 487 grid_hgr_nam%i_mshhgr = in_mshhgr488 grid_hgr_nam%d_ppglam0 = dn_ppglam0489 grid_hgr_nam%d_ppgphi0 = dn_ppgphi0490 491 grid_hgr_nam%d_ppe1_deg= dn_ppe1_deg492 grid_hgr_nam%d_ppe2_deg= dn_ppe2_deg493 ! grid_hgr_nam%d_ppe1_m = dn_ppe1_m494 ! grid_hgr_nam%d_ppe2_m = dn_ppe2_m495 496 ! grid_hgr_nam%i_cla = in_cla497 498 ! grid_hgr_nam%c_cfg = TRIM(cn_cfg)499 grid_hgr_nam%i_cfg = in_cfg500 grid_hgr_nam%l_bench = ln_bench494 tf_namh%c_coord = TRIM(cd_coord) 495 tf_namh%i_perio = id_perio 496 497 tf_namh%i_mshhgr = in_mshhgr 498 tf_namh%d_ppglam0 = dn_ppglam0 499 tf_namh%d_ppgphi0 = dn_ppgphi0 500 501 tf_namh%d_ppe1_deg= dn_ppe1_deg 502 tf_namh%d_ppe2_deg= dn_ppe2_deg 503 ! tf_namh%d_ppe1_m = dn_ppe1_m 504 ! tf_namh%d_ppe2_m = dn_ppe2_m 505 506 ! tf_namh%i_cla = in_cla 507 508 ! tf_namh%c_cfg = TRIM(cn_cfg) 509 tf_namh%i_cfg = in_cfg 510 tf_namh%l_bench = ln_bench 501 511 502 512 ELSE … … 507 517 508 518 END FUNCTION grid_hgr_nam 519 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 520 SUBROUTINE grid_hgr_fill(td_nam, jpi, jpj, ld_domcfg) 509 521 !------------------------------------------------------------------- 510 522 !> @brief This subroutine fill horizontal mesh (hgr structure) … … 517 529 !> @param[in] jpj 518 530 !------------------------------------------------------------------- 519 SUBROUTINE grid_hgr_fill(td_nam,jpi,jpj,ld_domcfg) 531 520 532 IMPLICIT NONE 533 521 534 ! Argument 522 535 TYPE(TNAMH), INTENT(IN) :: td_nam … … 600 613 601 614 END SUBROUTINE grid_hgr_fill 615 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 616 SUBROUTINE grid_hgr__fill_curv(td_nam)!,jpi,jpj) 602 617 !------------------------------------------------------------------- 603 618 !> @brief This subroutine fill horizontal mesh (hgr structure) … … 613 628 ! @param[in] jpj 614 629 !------------------------------------------------------------------- 615 SUBROUTINE grid_hgr__fill_curv( td_nam )!,jpi,jpj ) 630 616 631 IMPLICIT NONE 632 617 633 ! Argument 618 634 TYPE(TNAMH), INTENT(IN) :: td_nam … … 833 849 834 850 END SUBROUTINE grid_hgr__fill_curv 851 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 852 SUBROUTINE grid_hgr__fill_reg(td_nam, jpi, jpj) 835 853 !------------------------------------------------------------------- 836 854 !> @brief This subroutine fill horizontal mesh (hgr structure) … … 844 862 !> @param[in] jpj 845 863 !------------------------------------------------------------------- 846 SUBROUTINE grid_hgr__fill_reg(td_nam,jpi,jpj) 864 847 865 IMPLICIT NONE 866 848 867 ! Argument 849 868 TYPE(TNAMH), INTENT(IN) :: td_nam … … 893 912 894 913 END SUBROUTINE grid_hgr__fill_reg 914 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 915 SUBROUTINE grid_hgr__fill_plan(td_nam, jpi, jpj) 895 916 !------------------------------------------------------------------- 896 917 !> @brief This subroutine fill horizontal mesh (hgr structure) … … 904 925 !> @param[in] jpj 905 926 !------------------------------------------------------------------- 906 SUBROUTINE grid_hgr__fill_plan(td_nam,jpi,jpj) 927 907 928 IMPLICIT NONE 929 908 930 ! Argument 909 931 TYPE(TNAMH), INTENT(IN) :: td_nam … … 970 992 971 993 END SUBROUTINE grid_hgr__fill_plan 994 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 995 SUBROUTINE grid_hgr__fill_merc(td_nam, jpi, jpj) 972 996 !------------------------------------------------------------------- 973 997 !> @brief This subroutine fill horizontal mesh (hgr structure) … … 981 1005 !> @param[in] jpj 982 1006 !------------------------------------------------------------------- 983 SUBROUTINE grid_hgr__fill_merc(td_nam,jpi,jpj) 1007 984 1008 IMPLICIT NONE 1009 985 1010 ! Argument 986 1011 TYPE(TNAMH), INTENT(IN) :: td_nam … … 1047 1072 1048 1073 END SUBROUTINE grid_hgr__fill_merc 1074 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1075 SUBROUTINE grid_hgr__fill_gyre(td_nam, jpi, jpj) 1049 1076 !------------------------------------------------------------------- 1050 1077 !> @brief This subroutine fill horizontal mesh (hgr structure) … … 1058 1085 !> @param[in] jpj 1059 1086 !------------------------------------------------------------------- 1060 SUBROUTINE grid_hgr__fill_gyre(td_nam,jpi,jpj) 1087 1061 1088 IMPLICIT NONE 1089 1062 1090 ! Argument 1063 1091 TYPE(TNAMH), INTENT(IN) :: td_nam … … 1144 1172 1145 1173 END SUBROUTINE grid_hgr__fill_gyre 1174 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1175 SUBROUTINE grid_hgr__fill_coriolis(td_nam, jpi)!,jpj) 1146 1176 !------------------------------------------------------------------- 1147 1177 !> @brief This subroutine fill coriolis factor … … 1156 1186 ! @param[in] jpj 1157 1187 !------------------------------------------------------------------- 1158 SUBROUTINE grid_hgr__fill_coriolis(td_nam,jpi)!,jpj) 1188 1159 1189 IMPLICIT NONE 1190 1160 1191 ! Argument 1161 1192 TYPE(TNAMH), INTENT(IN) :: td_nam … … 1218 1249 1219 1250 END SUBROUTINE grid_hgr__fill_coriolis 1251 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1252 SUBROUTINE grid_hgr__angle(td_nam, jpi, jpj) 1220 1253 !!---------------------------------------------------------------------- 1221 ! !@brief This subroutine compute angles between model grid lines and the North direction1254 !> @brief This subroutine compute angles between model grid lines and the North direction 1222 1255 !> 1223 1256 !> @details … … 1241 1274 !> @param[in] jpj 1242 1275 !!---------------------------------------------------------------------- 1243 SUBROUTINE grid_hgr__angle(td_nam, jpi,jpj) 1276 1244 1277 IMPLICIT NONE 1278 1245 1279 ! Argument 1246 1280 TYPE(TNAMH), INTENT(IN) :: td_nam … … 1408 1442 1409 1443 END SUBROUTINE grid_hgr__angle 1444 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1410 1445 END MODULE grid_hgr
Note: See TracChangeset
for help on using the changeset viewer.
